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 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h4 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h6 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h7 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h8 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h9 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h10 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h11 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h12 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h13 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h14 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h15 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h16 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h17 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h18 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h19 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h20 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h21 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h22 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h23 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h24 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h25 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h26 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h27 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h28 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h29 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h30 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h31 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h32 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h33 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h34 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h35 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h36 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h37 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h38 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h39 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h40 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h41 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h42 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h43 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h44 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h45 : ∀ i j : ℤ, i ≠
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 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h2 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h3 : ∀ i : ℤ, int.fract (α * ↑i) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from sorry,
  have h4 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h5 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h6 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h7 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h8 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h9 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h10 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h11 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h12 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h13 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h14 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h15 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h16 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h17 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h18 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h19 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h20 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h21 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h22 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h23 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h24 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h25 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h26 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h27 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h28 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h29 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h30 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h31 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h32 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h33 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h34 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h35 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h36 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h37 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h38 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h39 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h40 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h41 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from sorry,
  have h42 : ∀ i : ℤ, int.fract (α * ↑i) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from sorry,
  have h43 : ∀ i : ℤ, int.
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 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h4 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h6 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h7 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h8 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h9 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h10 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h11 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h12 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h13 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h14 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h15 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h16 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h17 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h18 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h19 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h20 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h21 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h22 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h23 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h24 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h25 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h26 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h27 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h28 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h29 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h30 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h31 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h32 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h33 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h34 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h35 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h36 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h37 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h38 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h39 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h40 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h41 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h42 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h43 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h44 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,
  have h45 : ∀ i j : ℤ, 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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
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
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
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
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  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) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
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  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


-- liftedCIA: Variability-aware Change Impact Assessment
import .cia
import .variability

open CIA
open variability

namespace liftedCIA

def Annotation' := Var Annotation
def SysEl' := Var SysEl
def GSNEl' := Var GSNEl

def Sys' : Type := set' SysEl
def GSN' : Type := set' GSNEl

def TraceRel' := set' (SysEl × GSNEl)

open variability.has_index

def indexTraceRel (t: TraceRel') (pc : PC) : set (SysEl × GSNEl) :=
    index t pc

instance TraceRel_has_index : has_index TraceRel' :=
⟨ indexTraceRel ⟩

constant sliceSys'   (s : Sys')  (es : set' SysEl) : Sys'
constant sliceGSN_V' (ac : GSN') (es : set' GSNEl) : GSN'
constant sliceGSN_R' (ac : GSN') (es : set' GSNEl) : GSN'

axiom sliceSys_correct : ∀ (s : Sys')  (es : set' SysEl) (pc : PC),
index (sliceSys' s es) pc = sliceSys (index s pc) (index es pc)

axiom sliceGSNV_correct : ∀ (ac : GSN')  (es : set' GSNEl) (pc : PC),
index (sliceGSN_V' ac es) pc = sliceGSN_V (index ac pc) (index es pc)

axiom sliceGSNR_correct : ∀ (ac : GSN')  (es : set' GSNEl) (pc : PC),
index (sliceGSN_R' ac es) pc = sliceGSN_R (index ac pc) (index es pc)

structure Delta' :=
mk :: (add : set' SysEl) (delete : set' SysEl) (modify : set' SysEl)

open variability.has_index

def indexDelta (d : Delta') (pc : PC) :=
    let a := index d.add pc,
        l := index d.delete pc,
        m := index d.modify pc
    in  Delta.mk a l m

instance Delta_has_index : has_index Delta' :=
⟨ indexDelta ⟩

def restrict' (t : TraceRel') (d : Delta') : TraceRel' :=
    let relevant := d.add ∪ d.delete ∪ d.modify
    in  λ x, t x ∧ relevant x.1

theorem restrict_correct : ∀ (pc : PC) (t : TraceRel') (d : Delta'),
    index (restrict' t d) pc = restrict (index t pc) (indexDelta d pc)
    :=
begin
    intros,
    rw restrict, rw indexDelta, simp,
    repeat {rw index}, repeat {rw function.comp},
    unfold has_mem.mem, unfold set.mem,
    apply funext, intros,
    repeat {rw ←and_or_distrib_left}, rw ←and_assoc, rw ←and_comm pc,
    rw ←and_assoc, rw and_self pc, rw and_assoc, rw ←and.rotate,
    rw restrict', simp, rw ←and_assoc, rw and_comm pc,
    unfold has_union.union, repeat {rw variability.union}, simp,
    rw and_assoc
end

def trace' (t : TraceRel') (es : set' SysEl) : set' GSNEl :=
    λ (g:GSNEl), ∃ (s : SysEl) , es s ∧ t ⟨s , g⟩

theorem trace_correct : ∀ (t : TraceRel') (es : set' SysEl) (pc : PC),
    index (trace' t es) pc = trace (index t pc) (index es pc)
    :=
begin
    intros, repeat {rw index}, repeat {rw function.comp},
    rw trace', rw CIA.trace, simp, funext, simp,
    unfold has_mem.mem, rw ←exists_and_distrib_left, split,
        intro h, cases h with x h₁, existsi x, repeat {rw set.mem},
            rw and.left_comm, rw and.assoc, rw ←and.assoc, rw and_self,
            apply h₁,
        intro h, cases h with x h₁, existsi x, repeat {rw set.mem at h₁},
            rw and.left_comm at h₁, rw and.assoc at h₁, rw ←and.assoc at h₁,
            rw and_self at h₁, exact h₁
end

def createAnnotation'   (g : GSN')
                        (recheck : set' GSNEl)
                        (revise : set' GSNEl)
                    : set' (GSNEl × Annotation) :=
    let ch := image (λ e, (e, Annotation.Recheck)) recheck,
        rv := image (λ e, (e, Annotation.Revise)) revise,
        n  := image (λ e, (e, Annotation.Reuse)) (g - (recheck ∪ revise))
    in  ch ∪ rv ∪ n

theorem createAnnotation_correct:
    ∀ (g : GSN') (recheck : set' GSNEl) (revise : set' GSNEl) (pc : PC),
    index (createAnnotation' g recheck revise) pc =
    createAnnotation (index g pc) (index recheck pc) (index revise pc)
    :=
begin
    intros, repeat {rw index}, repeat {rw function.comp},
    rw createAnnotation, rw createAnnotation', simp,
    repeat {rw image}, repeat {rw set.union_def}, simp, unfold has_sdiff.sdiff,
    rw set.diff, simp, funext, simp,
    repeat {rw image}, repeat {rw set.union_def}, simp,
    repeat {rw set.union_def}, dsimp,
    repeat {rw set.mem_def},
end

open Delta'

def GSN_IA' (S S' : Sys')
            (A  : GSN')
            (R  : TraceRel')
            (D  : Delta')
            : set' (GSNEl × Annotation) :=
    let R'          := restrict' R D,
        C1dm        := sliceSys' S (D.delete ∪ D.modify),
        C1am        := sliceSys' S' (D.add ∪ D.modify),
        C2Recheck   := (trace' R C1dm) ∪ (trace' R' C1am),
        C2Revise    := trace' R D.delete,
        C3Recheck1  := sliceGSN_V' A C2Revise,
        C3Recheck2  := sliceGSN_R' A (C2Recheck ∪ C3Recheck1)
    in  createAnnotation' A C3Recheck2 C2Revise

universe u
variables {α β γ : Type}

open set
open variability
open variability.has_index

lemma index_union : ∀ {α : Type _} (s₁ s₂ : set' α) (pc : PC),
(index (s₁ ∪ s₂) pc) = (index s₁ pc) ∪ (index s₂ pc) :=
begin
    intros, unfold has_union.union, unfold variability.union, unfold set.union,
    unfold has_mem.mem, unfold set.mem,
    rw index, rw index, rw index,
    rw function.comp, rw function.comp, rw function.comp, simp,
    apply funext, intro,
    rw and_or_distrib_left, refl
end

theorem GSN_IA'_correct :
    ∀ (S S' : Sys') (A  : GSN') (R  : TraceRel') (D : Delta') (pc : PC),
    (GSN_IA' S S' A R D) | pc = GSN_IA  (S | pc) (S' | pc) (A | pc) (R | pc) (D | pc)
    :=
begin
    intros, rw GSN_IA', rw GSN_IA, simp,
    rw← restrict_correct, rw indexDelta, simp,
    rw ←index_union, rw ←index_union, rw← sliceSys_correct,
    rw← trace_correct, rw← trace_correct, rw← sliceSys_correct,
    rw← trace_correct, rw← sliceGSNV_correct, rw ←index_union,
    rw ←index_union, rw← sliceGSNR_correct, rw← createAnnotation_correct
end

end liftedCIA


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison, Jakob von Raumer
-/
import algebra.homology.quasi_iso
import category_theory.abelian.homology
import category_theory.preadditive.projective_resolution
import category_theory.preadditive.yoneda.limits
import category_theory.preadditive.yoneda.projective

/-!
# Abelian categories with enough projectives have projective resolutions

When `C` is abelian `projective.d f` and `f` are exact.
Hence, starting from an epimorphism `P ⟶ X`, where `P` is projective,
we can apply `projective.d` repeatedly to obtain a projective resolution of `X`.
-/

noncomputable theory

open category_theory
open category_theory.limits
open opposite

universes v u v' u'

namespace category_theory

open category_theory.projective

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

/--
When `C` is abelian, `projective.d f` and `f` are exact.
-/
lemma exact_d_f [enough_projectives C] {X Y : C} (f : X ⟶ Y) : exact (d f) f :=
(abelian.exact_iff _ _).2 $
  ⟨by simp, zero_of_epi_comp (π _) $ by rw [←category.assoc, cokernel.condition]⟩

/-- The preadditive Co-Yoneda functor on `P` preserves colimits if `P` is projective. -/
def preserves_finite_colimits_preadditive_coyoneda_obj_of_projective (P : C)
  [hP : projective P] : preserves_finite_colimits (preadditive_coyoneda_obj (op P)) :=
begin
  letI := (projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj' P).mp hP,
  apply functor.preserves_finite_colimits_of_preserves_epis_and_kernels,
end

/-- An object is projective if its preadditive Co-Yoneda functor preserves finite colimits. -/
lemma projective_of_preserves_finite_colimits_preadditive_coyoneda_obj (P : C)
  [hP : preserves_finite_colimits (preadditive_coyoneda_obj (op P))] : projective P :=
begin
  rw projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj',
  apply_instance
end

namespace ProjectiveResolution

/-!
Our goal is to define `ProjectiveResolution.of Z : ProjectiveResolution Z`.
The `0`-th object in this resolution will just be `projective.over Z`,
i.e. an arbitrarily chosen projective object with a map to `Z`.
After that, we build the `n+1`-st object as `projective.syzygies`
applied to the previously constructed morphism,
and the map to the `n`-th object as `projective.d`.
-/
variables [enough_projectives C]

/-- Auxiliary definition for `ProjectiveResolution.of`. -/
@[simps]
def of_complex (Z : C) : chain_complex C ℕ :=
chain_complex.mk'
  (projective.over Z) (projective.syzygies (projective.π Z)) (projective.d (projective.π Z))
  (λ ⟨X, Y, f⟩, ⟨projective.syzygies f, projective.d f, (exact_d_f f).w⟩)

/--
In any abelian category with enough projectives,
`ProjectiveResolution.of Z` constructs a projective resolution of the object `Z`.
-/
@[irreducible] def of (Z : C) : ProjectiveResolution Z :=
{ complex := of_complex Z,
  π := chain_complex.mk_hom _ _ (projective.π Z) 0
    (by { simp, exact (exact_d_f (projective.π Z)).w.symm, })
    (λ n _, ⟨0, by ext⟩),
  projective := by { rintros (_|_|_|n); apply projective.projective_over, },
  exact₀ := by simpa using exact_d_f (projective.π Z),
  exact := by { rintros (_|n); { simp, apply exact_d_f, }, },
  epi := projective.π_epi Z, }

@[priority 100]
instance (Z : C) : has_projective_resolution Z :=
{ out := ⟨of Z⟩ }

@[priority 100]
instance : has_projective_resolutions C :=
{ out := λ Z, by apply_instance }

end ProjectiveResolution
end category_theory
namespace homological_complex.hom

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

/-- If `X` is a chain complex of projective objects and we have a quasi-isomorphism `f : X ⟶ Y[0]`,
then `X` is a projective resolution of `Y.` -/
def to_single₀_ProjectiveResolution {X : chain_complex C ℕ} {Y : C}
  (f : X ⟶ (chain_complex.single₀ C).obj Y) [quasi_iso f]
  (H : ∀ n, projective (X.X n)) :
  ProjectiveResolution Y :=
{ complex := X,
  π := f,
  projective := H,
  exact₀ := f.to_single₀_exact_d_f_at_zero,
  exact := f.to_single₀_exact_at_succ,
  epi := f.to_single₀_epi_at_zero }

end homological_complex.hom


import .ast .errors .linking

/- Type expressions for the Compcert C and Clight languages -/

namespace ctypes
open ast maps errors linking
open ast.external_function ast.memory_chunk

/- Compcert C types are similar to those of C.  They include numeric types,
  pointers, arrays, function types, and composite types (struct and
  union).  Numeric types (integers and floats) fully specify the
  bit size of the type.  An integer type is a pair of a signed/unsigned
  flag and a bit size: 8, 16, or 32 bits, or the special [IBool] size
  standing for the C99 [_Bool] type.  64-bit integers are treated separately. -/

inductive signedness : Type
| Signed : signedness
| Unsigned : signedness
open signedness

inductive intsize : Type
| I8 : intsize
| I16 : intsize
| I32 : intsize
| IBool : intsize
open intsize

/- Float types come in two sizes: 32 bits (single precision)
  and 64-bit (double precision). -/

inductive floatsize : Type
| F32 : floatsize
| F64 : floatsize
open floatsize

/- Every type carries a set of attributes.  Currently, only two
  attributes are modeled: [volatile] and [_Alignas(n)] (from ISO C 2011). -/

structure attr : Type :=
(attr_volatile : bool)
(attr_alignas : option ℕ)  /- log2 of required alignment -/

instance attr_eq : decidable_eq attr := by tactic.mk_dec_eq_instance

def noattr : attr := { attr_volatile := false, attr_alignas := none }

/- The syntax of type expressions.  some points to note:
- Array types [Tarray n] carry the size [n] of the array.
  Arrays with unknown sizes are represented by pointer types.
- Function types [Tfunction targs tres] specify the number and types
  of the function arguments (list [targs]), and the type of the
  function result ([tres]).  Variadic functions and old-style unprototyped
  functions are not supported.
-/

inductive type : Type
| Tvoid : type                                    /- the [void] type -/
| Tint : intsize → signedness → attr → type    /- integer types -/
| Tlong : signedness → attr → type              /- 64-bit integer types -/
| Tfloat : floatsize → attr → type              /- floating-point types -/
| Tpointer : type → attr → type                 /- pointer types ([*ty]) -/
| Tarray : type → ℕ → attr → type              /- array types ([ty[len]]) -/
| Tfunction : list type → type → calling_convention → type    /- function types -/
| Tstruct : ident → attr → type                 /- struct types -/
| Tunion : ident → attr → type                  /- union types -/
export type

instance intsize_eq : decidable_eq intsize := by tactic.mk_dec_eq_instance

instance type_eq : decidable_eq type := sorry' --by tactic.mk_dec_eq_instance

/- Extract the attributes of a type. -/

def attr_of_type : type → attr
| Tvoid                   := noattr
| (Tint sz si a)          := a
| (Tlong si a)            := a
| (Tfloat sz a)           := a
| (Tpointer elt a)        := a
| (Tarray elt sz a)       := a
| (Tfunction args res cc) := noattr
| (Tstruct id a)          := a
| (Tunion id a)           := a

/- Change the top-level attributes of a type -/

def change_attributes (f : attr → attr) : type → type
| (Tint sz si a)          := Tint sz si (f a)
| (Tlong si a)            := Tlong si (f a)
| (Tfloat sz a)           := Tfloat sz (f a)
| (Tpointer elt a)        := Tpointer elt (f a)
| (Tarray elt sz a)       := Tarray elt sz (f a)
| (Tstruct id a)          := Tstruct id (f a)
| (Tunion id a)           := Tunion id (f a)
| ty                      := ty

/- Erase the top-level attributes of a type -/

def remove_attributes (ty : type) : type :=
  change_attributes (λ_, noattr) ty

/- Add extra attributes to the top-level attributes of a type -/

def attr_union (a1 a2 : attr) : attr :=
{ attr_volatile := a1.attr_volatile || a2.attr_volatile,
  attr_alignas :=
    match a1.attr_alignas, a2.attr_alignas with
    | none, al := al
    | al, none := al
    | some n1, some n2 := some (max n1 n2)
    end }

def merge_attributes (ty : type) (a : attr) : type :=
change_attributes (attr_union a) ty

/- Syntax for [struct] and [union] definitions.  [struct] and [union]
  are collectively called "composites".  Each compilation unit
  comes with a list of top-level definitions of composites. -/

inductive struct_or_union : Type | struct | union

instance struct_or_union_eq : decidable_eq struct_or_union := by tactic.mk_dec_eq_instance

def members : Type := list (ident × type).
instance : has_mem (ident × type) members := ⟨@has_mem.mem _ (list _) _⟩

structure composite_definition : Type :=
(id : ident) (su : struct_or_union) (m : members) (a : attr)

def name_composite_def : composite_definition → ident :=
composite_definition.id

instance composite_def_eq : decidable_eq composite_definition := by tactic.mk_dec_eq_instance

/- For type-checking, compilation and semantics purposes, the composite
  definitions are collected in the following [composite_env] environment.
  The [composite] record contains additional information compared with
  the [composite_definition], such as size and alignment information. -/

structure composite : Type :=
(co_su : struct_or_union)
(co_members : members)
(co_attr : attr)
(co_sizeof : ℕ)
(co_alignof : ℕ)
(co_rank : ℕ)
(co_alignof_two_p : ∃ n, co_alignof = 2^n)
(co_sizeof_alignof : co_alignof ∣ co_sizeof)
open composite

def composite_env : Type := PTree composite

/- * Operations over types -/

/- ** Conversions -/

def type_int32s := Tint I32 Signed noattr
def type_bool := Tint IBool Signed noattr

/- The usual unary conversion.  Promotes small integer types to [signed int32]
  and degrades array types and function types to pointer types.
  Attributes are erased. -/

def typeconv (ty : type) : type :=
match ty with
| Tint I8 _ _     := Tint I32 Signed noattr
| Tint I16 _ _    := Tint I32 Signed noattr
| Tint IBool _ _  := Tint I32 Signed noattr
| Tarray t sz a   := Tpointer t noattr
| Tfunction _ _ _ := Tpointer ty noattr
| _               := remove_attributes ty
end

/- Default conversion for arguments to an unprototyped or variadic function.
  Like [typeconv] but also converts single floats to double floats. -/

def default_argument_conversion (ty : type) : type :=
match ty with
| Tint I8 _ _     := Tint I32 Signed noattr
| Tint I16 _ _    := Tint I32 Signed noattr
| Tint IBool _ _  := Tint I32 Signed noattr
| Tfloat _ _      := Tfloat F64 noattr
| Tarray t sz a   := Tpointer t noattr
| Tfunction _ _ _ := Tpointer ty noattr
| _               := remove_attributes ty
end

/- ** Complete types -/

/- A type is complete if it fully describes an object.
  All struct and union names appearing in the type must be defined,
  unless they occur under a pointer or function type.  [void] and
  function types are incomplete types. -/

def complete_type (env : composite_env) : type → bool
| Tvoid             := ff
| (Tint _ _ _)      := tt
| (Tlong _ _)       := tt
| (Tfloat _ _)      := tt
| (Tpointer _ _)    := tt
| (Tarray t' _ _)   := complete_type t'
| (Tfunction _ _ _) := ff
| (Tstruct id _)    := (env^!id).is_some
| (Tunion id _)     := (env^!id).is_some

def complete_or_function_type (env : composite_env) : type → bool
| (Tfunction _ _ _) := true
| t := complete_type env t

/- ** Alignment of a type -/

/- Adjust the natural alignment [al] based on the attributes [a] attached
  to the type.  If an "alignas" attribute is given, use it as alignment
  in preference to [al]. -/

def align_attr (a : attr) (al : ℕ) : ℕ :=
match a.attr_alignas with
| some l := 2^l
| none := al
end

/- In the ISO C standard, alignment is defined only for complete
  types.  However, it is convenient that [alignof] is a total
  function.  For incomplete types, it returns 1. -/

def alignof_inner (env : composite_env) : type → ℕ
| Tvoid             := 1
| (Tint I8 _ _)     := 1
| (Tint I16 _ _)    := 2
| (Tint I32 _ _)    := 4
| (Tint IBool _ _)  := 1
| (Tlong _ _)       := archi.align_int64
| (Tfloat F32 _)    := 4
| (Tfloat F64 _)    := archi.align_float64
| (Tpointer _ _)    := if archi.ptr64 then 8 else 4
| (Tarray t' _ _)   := align_attr (attr_of_type t') (alignof_inner t')
| (Tfunction _ _ _) := 1
| (Tstruct id _)    := match env^!id with some co := co_alignof co | none := 1 end
| (Tunion id _)     := match env^!id with some co := co_alignof co | none := 1 end

def alignof (env : composite_env) (t : type) : ℕ :=
align_attr (attr_of_type t) (alignof_inner env t)

theorem align_attr_two_p (al a) :
  (∃ n, al = 2^n) →
  (∃ n, align_attr a al = 2^n) := sorry'

theorem alignof_two_p (env t) : ∃ n, alignof env t = 2^n := sorry'

theorem alignof_pos (env t) : alignof env t > 0 := sorry'

/- ** Size of a type -/

/- In the ISO C standard, size is defined only for complete
  types.  However, it is convenient that [sizeof] is a total
  function.  For [void] and function types, we follow GCC and define
  their size to be 1.  For undefined structures and unions, the size is
  arbitrarily taken to be 0.
-/

def sizeof (env: composite_env) : type → ℕ
| Tvoid             := 1
| (Tint I8 _ _)     := 1
| (Tint I16 _ _)    := 2
| (Tint I32 _ _)    := 4
| (Tint IBool _ _)  := 1
| (Tlong _ _)       := 8
| (Tfloat F32 _)    := 4
| (Tfloat F64 _)    := 8
| (Tpointer _ _)    := if archi.ptr64 then 8 else 4
| (Tarray t' n _)   := sizeof t' * n
| (Tfunction _ _ _) := 1
| (Tstruct id _)    := match env^!id with some co := co_sizeof co | none := 0 end
| (Tunion id _)     := match env^!id with some co := co_sizeof co | none := 0 end

lemma sizeof_pos (env t) : sizeof env t >= 0 := sorry'

/- The size of a type is an integral multiple of its alignment,
  unless the alignment was artificially increased with the [__Alignas]
  attribute. -/

def naturally_aligned : type → Prop
| (Tarray t' _ a) := attr.attr_alignas a = none ∧ naturally_aligned t'
| t := attr.attr_alignas (attr_of_type t) = none

lemma sizeof_alignof_compat (env t) (h : naturally_aligned t) :
  alignof env t ∣ sizeof env t := sorry'

/- ** Size and alignment for composite definitions -/

/- The alignment for a structure or union is the max of the alignment
  of its members. -/

def alignof_composite (env : composite_env) : members → ℕ
| [] := 1
| ((id, t) :: m') := max (alignof env t) (alignof_composite m')

/- The size of a structure corresponds to its layout: fields are
  laid out consecutively, and padding is inserted to align
  each field to the alignment for its type. -/

def sizeof_struct (env : composite_env) : ℕ → members → ℕ
| cur [] := cur
| cur ((id, t) :: m') := sizeof_struct (align cur (alignof env t) + sizeof env t) m'

/- The size of an union is the max of the sizes of its members. -/

def sizeof_union (env : composite_env) : members → ℕ
| [] := 0
| ((id, t) :: m') := max (sizeof env t) (sizeof_union m')

lemma alignof_composite_two_p (env m) : ∃ n, alignof_composite env m = 2^n := sorry'

lemma alignof_composite_pos (env m a) : align_attr a (alignof_composite env m) > 0 := sorry'

lemma sizeof_struct_incr (env m cur) : cur ≤ sizeof_struct env cur m := sorry'

lemma sizeof_union_pos (env m) : 0 ≤ sizeof_union env m := sorry'

/- ** Byte offset for a field of a structure -/

/- [field_offset env id fld] returns the byte offset for field [id]
  in a structure whose members are [fld].  Fields are laid out
  consecutively, and padding is inserted to align each field to the
  alignment for its type. -/

def field_offset_rec (env : composite_env) (id : ident) : members → ℕ → res ℕ
| []                 pos := error [MSG "Unknown field ", CTX id]
| ((id', t) :: fld') pos :=
      if id = id'
      then OK (align pos (alignof env t))
      else field_offset_rec fld' (align pos (alignof env t) + sizeof env t)

def field_offset (env : composite_env) (id : ident) (fld : members) : res ℕ :=
field_offset_rec env id fld 0

def field_type (id : ident) : members → res type
| []                 := error [MSG "Unknown field ", CTX id]
| ((id', t) :: fld') := if id = id' then OK t else field_type fld'

/- some sanity checks about field offsets.  First, field offsets are
  within the range of acceptable offsets. -/

theorem field_offset_rec_in_range (env id ofs ty fld pos) :
  field_offset_rec env id fld pos = OK ofs → field_type id fld = OK ty →
  pos ≤ ofs ∧ ofs + sizeof env ty ≤ sizeof_struct env pos fld := sorry'

lemma field_offset_in_range (env fld id ofs ty) :
  field_offset env id fld = OK ofs → field_type id fld = OK ty →
  0 ≤ ofs ∧ ofs + sizeof env ty ≤ sizeof_struct env 0 fld := sorry'

/- Second, two distinct fields do not overlap -/

lemma field_offset_no_overlap (env id1 ofs1 ty1 id2 ofs2 ty2 fld) :
  field_offset env id1 fld = OK ofs1 → field_type id1 fld = OK ty1 →
  field_offset env id2 fld = OK ofs2 → field_type id2 fld = OK ty2 →
  id1 ≠ id2 → ofs1 + sizeof env ty1 ≤ ofs2 ∨ ofs2 + sizeof env ty2 ≤ ofs1 := sorry'

/- Third, if a struct is a prefix of another, the offsets of common fields
    are the same. -/

lemma field_offset_prefix (env id ofs fld2 fld1) :
  field_offset env id fld1 = OK ofs →
  field_offset env id (fld1 ++ fld2 : list _) = OK ofs := sorry'

/- Fourth, the position of each field respects its alignment. -/

lemma field_offset_aligned (env id fld ofs ty) :
  field_offset env id fld = OK ofs → field_type id fld = OK ty →
  ↑(alignof env ty) ∣ ofs := sorry'

/- ** Access modes -/

/- The [access_mode] function describes how a l-value of the given
type must be accessed:
- [By_value ch]: access by value, i.e. by loading from the address
  of the l-value using the memory chunk [ch];
- [By_reference]: access by reference, i.e. by just returning
  the address of the l-value (used for arrays and functions);
- [By_copy]: access is by reference, assignment is by copy
  (used for [struct] and [union] types)
- [By_nothing]: no access is possible, e.g. for the [void] type.
-/

inductive mode : Type
| By_value : memory_chunk → mode
| By_reference : mode
| By_copy : mode
| By_nothing : mode
open mode ast.memory_chunk

def access_mode : type → mode
| (Tint I8 Signed _)    := By_value Mint8signed
| (Tint I8 Unsigned _)  := By_value Mint8unsigned
| (Tint I16 Signed _)   := By_value Mint16signed
| (Tint I16 Unsigned _) := By_value Mint16unsigned
| (Tint I32 _ _)        := By_value Mint32
| (Tint IBool _ _)      := By_value Mint8unsigned
| (Tlong _ _)           := By_value Mint64
| (Tfloat F32 _)        := By_value Mfloat32
| (Tfloat F64 _)        := By_value Mfloat64
| (Tvoid)               := By_nothing
| (Tpointer _ _)        := By_value Mptr
| (Tarray _ _ _)        := By_reference
| (Tfunction _ _ _)     := By_reference
| (Tstruct _ _)         := By_copy
| (Tunion _ _)          := By_copy

/- For the purposes of the semantics and the compiler, a type denotes
  a volatile access if it carries the [volatile] attribute and it is
  accessed by value. -/

def type_is_volatile (ty: type) : bool :=
  match access_mode ty with
  | By_value _ := attr.attr_volatile (attr_of_type ty)
  | _          := false
  end.

/- ** Alignment for block copy operations -/

/- A variant of [alignof] for use in block copy operations.
  Block copy operations do not support alignments greater than 8,
  and require the size to be an integral multiple of the alignment. -/

def alignof_blockcopy (env : composite_env) : type → ℤ
| Tvoid             := 1
| (Tint I8 _ _)     := 1
| (Tint I16 _ _)    := 2
| (Tint I32 _ _)    := 4
| (Tint IBool _ _)  := 1
| (Tlong _ _)       := 8
| (Tfloat F32 _)    := 4
| (Tfloat F64 _)    := 8
| (Tpointer _ _)    := if archi.ptr64 then 8 else 4
| (Tarray t' _ _)   := alignof_blockcopy t'
| (Tfunction _ _ _) := 1
| (Tstruct id _ )   := match env^!id with some co := min 8 (co_alignof co) | none := 1 end
| (Tunion id _)     := match env^!id with some co := min 8 (co_alignof co) | none := 1 end

lemma alignof_blockcopy_1248 (env ty) :
  let a := alignof_blockcopy env ty in
  a = 1 ∨ a = 2 ∨ a = 4 ∨ a = 8 := sorry'

lemma alignof_blockcopy_pos (env ty) : alignof_blockcopy env ty > 0 := sorry'

lemma sizeof_alignof_blockcopy_compat (env ty) :
  alignof_blockcopy env ty ∣ sizeof env ty := sorry'

/- Type ranks -/

/- The rank of a type is a nonnegative integer that measures the direct nesting
  of arrays, struct and union types.  It does not take into account indirect
  nesting such as a struct type that appears under a pointer or function type.
  Type ranks ensure that type expressions (ignoring pointer and function types)
  have an inductive structure. -/

def rank_type (ce : composite_env) : type → nat
| (Tarray t' _ _) := rank_type t' + 1
| (Tstruct id _) :=
  match ce^!id with
  | none := 0
  | some co := co_rank co + 1
  end
| (Tunion id _) :=
  match ce^!id with
  | none := 0
  | some co := co_rank co + 1
  end
| _ := 0

def rank_members (ce : composite_env) : members → nat
| [] := 0
| ((id, t) :: m) := max (rank_type ce t) (rank_members m)

/- ** C types and back-end types -/

/- Extracting a type list from a function parameter declaration. -/

def type_of_params : list (ident × type) → list type
| [] := []
| ((id, ty) :: rem) := ty :: type_of_params rem

/- Translating C types to Cminor types and function signatures. -/

def typ_of_type : type → ast.typ
| Tvoid             := ast.typ.Tint
| (Tint _ _ _)      := ast.typ.Tint
| (Tlong _ _)       := ast.typ.Tlong
| (Tfloat F32 _)    := ast.typ.Tsingle
| (Tfloat F64 _)    := ast.typ.Tfloat
| (Tpointer _ _)    := ast.typ.Tptr
| (Tarray _ _ _)    := ast.typ.Tptr
| (Tfunction _ _ _) := ast.typ.Tptr
| (Tstruct _ _)     := ast.typ.Tptr
| (Tunion _ _)      := ast.typ.Tptr

def opttyp_of_type (t : type) : option ast.typ :=
  if t = Tvoid then none else some (typ_of_type t)

def typlist_of_typelist (l : list type) : list ast.typ := l.map typ_of_type

def signature_of_type (args : list type) (res : type) (cc : calling_convention) : signature :=
signature.mk (args.map typ_of_type) (opttyp_of_type res) cc

/- * Construction of the composite environment -/

def sizeof_composite (env : composite_env) : struct_or_union → members → ℕ
| struct_or_union.struct := sizeof_struct env 0
| struct_or_union.union  := sizeof_union env

lemma sizeof_composite_pos (env su m) : 0 ≤ sizeof_composite env su m := sorry'

def complete_members (env : composite_env) : members → bool
| [] := true
| ((id, t) :: m') := complete_type env t && complete_members m'

lemma complete_member (env) (id : ident) (t m) :
  (id, t) ∈ m →
  complete_members env m = true →
  complete_type env t = true := sorry'

/- Convert a composite def to its internal representation.
  The size and alignment of the composite are determined at this time.
  The alignment takes into account the [__Alignas] attributes
  associated with the def.  The size is rounded up to a multiple
  of the alignment.

  The conversion fails if a type of a member is not complete.  This rules
  out incorrect recursive definitions such as
<<
    struct s { int x; struct s next; }
>>
  Here, when we process the def of [struct s], the identifier [s]
  is not bound yet in the composite environment, hence field [next]
  has an incomplete type.  However, recursions that go through a pointer type
  are correctly handled:
<<
    struct s { int x; struct s * next; }
>>
  Here, [next] has a pointer type, which is always complete, even though
  [s] is not yet bound to a composite.
-/

def composite_of_def (env : composite_env) (id : ident) (su : struct_or_union)
   (m : members) (a : attr) : res composite :=
match env^!id, complete_members env m with
| some _, _ :=
    error [MSG "Multiple definitions of struct or union ", CTX id]
| none, ff :=
    error [MSG "Incomplete struct or union ", CTX id]
| none, tt :=
    let al := align_attr a (alignof_composite env m) in
    OK { co_su := su,
         co_members := m,
         co_attr := a,
         co_sizeof := align (sizeof_composite env su m) al,
         co_alignof := al,
         co_rank := rank_members env m,
         co_alignof_two_p := sorry',
         co_sizeof_alignof := sorry' }
end

/- The composite environment for a program is obtained by entering
  its composite definitions in sequence.  The definitions are assumed
  to be listed in dependency order: the def of a composite
  must precede all uses of this composite, unless the use is under
  a pointer or function type. -/

def add_composite_definitions : composite_env →
  list composite_definition → res composite_env
| env [] := OK env
| env (⟨id, su, m, a⟩ :: defs) :=
    do co ← composite_of_def env id su m a,
    add_composite_definitions (PTree.set id co env) defs

def build_composite_env (defs: list composite_definition) :=
add_composite_definitions (∅ : PTree _) defs.

/- Stability properties for alignments, sizes, and ranks.  If the type is
  complete in a composite environment [env], its size, alignment, and rank
  are unchanged if we add more definitions to [env]. -/

section stability

variables env env': composite_env
variable h : ∀ id co, (env^!id) = some co → (env'^!id) = some co

lemma alignof_stable (t) : complete_type env t →
  alignof env' t = alignof env t := sorry'

lemma sizeof_stable (t) : complete_type env t →
  sizeof env' t = sizeof env t := sorry'

lemma complete_type_stable (t) : complete_type env t →
  complete_type env' t := sorry'

lemma rank_type_stable (t) : complete_type env t →
  rank_type env' t = rank_type env t := sorry'

lemma alignof_composite_stable (m) : complete_members env m →
  alignof_composite env' m = alignof_composite env m := sorry'

lemma sizeof_struct_stable (m pos) : complete_members env m →
  sizeof_struct env' pos m = sizeof_struct env pos m := sorry'

lemma sizeof_union_stable (m) : complete_members env m →
  sizeof_union env' m = sizeof_union env m := sorry'

lemma sizeof_composite_stable (su m) : complete_members env m →
  sizeof_composite env' su m = sizeof_composite env su m := sorry'

lemma complete_members_stable (m) : complete_members env m →
  complete_members env' m := sorry'

lemma rank_members_stable (m) : complete_members env m →
  rank_members env' m = rank_members env m := sorry'

end stability

lemma add_composite_definitions_incr (id co defs env1 env2) :
  add_composite_definitions env1 defs = OK env2 →
  (env1^!id) = some co → (env2^!id) = some co := sorry'

/- It follows that the sizes and alignments contained in the composite
  environment produced by [build_composite_env] are consistent with
  the sizes and alignments of the members of the composite types. -/

structure composite_consistent (env : composite_env) (co : composite) : Prop :=
(co_consistent_complete :
    complete_members env (co_members co))
(co_consistent_alignof :
    co_alignof co = align_attr (co_attr co) (alignof_composite env (co_members co)))
(co_consistent_sizeof:
    co_sizeof co = align (sizeof_composite env (co_su co) (co_members co)) (co_alignof co))
(co_consistent_rank:
    co_rank co = rank_members env (co_members co))

def composite_env_consistent (env: composite_env) : Prop :=
  ∀ id co, (env^!id) = some co → composite_consistent env co

lemma composite_consistent_stable (env env': composite_env)
  (ext : ∀ id co, (env^!id) = some co → (env'^!id) = some co)
  (co) : composite_consistent env co → composite_consistent env' co := sorry'

lemma composite_of_def_consistent (env id su m a co) :
  composite_of_def env id su m a = OK co →
  composite_consistent env co := sorry'

theorem build_composite_env_consistent (defs env) :
  build_composite_env defs = OK env → composite_env_consistent env := sorry'

/- Moreover, every composite def is reflected in the composite environment. -/

theorem build_composite_env_charact (id su m a defs env) :
  build_composite_env defs = OK env →
  composite_definition.mk id su m a ∈ defs →
  ∃ co, (env^!id) = some co ∧ co_members co = m ∧
        co_attr co = a ∧ co_su co = su := sorry'

theorem build_composite_env_domain (env defs id co) :
  build_composite_env defs = OK env →
  (env^!id) = some co →
  composite_definition.mk id (co_su co) (co_members co) (co_attr co) ∈ defs := sorry'

/- As a corollay, in a consistent environment, the rank of a composite type
  is strictly greater than the ranks of its member types. -/

theorem rank_type_members (ce id t m) : (id, t) ∈ m →
  rank_type ce t ≤ rank_members ce m := sorry'

lemma rank_struct_member (ce id a co id1 t1) :
  composite_env_consistent ce →
  (ce^!id) = some co →
  (id1, t1) ∈ co_members co →
  rank_type ce t1 < rank_type ce (Tstruct id a) := sorry'

lemma rank_union_member (ce id a co id1 t1) :
  composite_env_consistent ce →
  (ce^!id) = some co →
  (id1, t1) ∈ co_members co →
  rank_type ce t1 < rank_type ce (Tunion id a) := sorry'

/- * Programs and compilation units -/

/- The definitions in this section are parameterized over a type [F] of
  internal function definitions, so that they apply both to CompCert C and to Clight. -/

section programs

/- Functions can either be defined ([Internal]) or declared as
  external functions ([External]). -/

inductive fundef (F : Type) : Type
| Internal : F → fundef
| External {} : external_function → list type → type → calling_convention → fundef

/- A program, or compilation unit, is composed of:
- a list of definitions of functions and global variables;
- the names of functions and global variables that are public (not static);
- the name of the function that acts as entry point ("main" function).
- a list of definitions for structure and union names
- the corresponding composite environment
- a proof that this environment is consistent with the definitions. -/

structure program (F : Type) : Type :=
(defs: list (ident × globdef (fundef F) type))
(public: list ident)
(main: ident)
(types: list composite_definition)
(comp_env: composite_env)
(comp_env_eq: build_composite_env types = OK comp_env)

def program_of_program {F} (p : program F) : ast.program (fundef F) type :=
{ defs := p.defs,
  public := p.public,
  main := p.main }

instance {F} : has_coe (program F) (ast.program (fundef F) type) := ⟨program_of_program⟩

def make_program {F} (types: list composite_definition)
                     (defs: list (ident × globdef (fundef F) type))
                     (public: list ident)
                     (main: ident) : res (program F) :=
match _, rfl : ∀ r, build_composite_env types = r → _ with
| error e, h := error e
| OK ce, h :=
  OK { defs := defs,
       public := public,
       main := main,
       types := types,
       comp_env := ce,
       comp_env_eq := h }
end

end programs
open fundef

/- * Separate compilation and linking -/

/- ** Linking types -/

instance linker_types : linker type :=
{ link := λ t1 t2, if t1 = t2 then some t1 else none,
  linkorder := (=),
  linkorder_refl := eq.refl,
  linkorder_trans := @eq.trans _,
  link_linkorder := λt1 t2 t3, begin
    by_cases (t1 = t2) with h1; intro h2; simp [h1] at h2,
    { injection h2, exact ⟨h1.trans h, h⟩ },
    { contradiction } end }

/- ** Linking composite definitions -/

def check_compat_composite (l : list composite_definition) (cd : composite_definition) : bool :=
l.all (λ cd', if name_composite_def cd' = name_composite_def cd then cd = cd' else tt)

def filter_redefs (l1 l2 : list composite_definition) :=
let names1 := l1.map name_composite_def in
l2.filter (λ cd, name_composite_def cd ∉ names1)

def link_composite_defs (l1 l2 : list composite_definition) : option (list composite_definition) :=
if l1.all (check_compat_composite l2)
then some (l1 ++ filter_redefs l1 l2)
else none

lemma link_composite_def_inv {l1 l2 l} (h : link_composite_defs l1 l2 = some l) :
    (∀ cd1 ∈ l1, ∀ cd2 ∈ l2, name_composite_def cd2 = name_composite_def cd1 → cd2 = cd1)
  ∧ l = l1 ++ filter_redefs l1 l2
  ∧ (∀ {x}, x ∈ l ↔ x ∈ l1 ∨ x ∈ l2) := sorry'

instance Linker_composite_defs : linker (list composite_definition) :=
{ link := link_composite_defs,
  linkorder := (⊆),
  linkorder_refl := list.subset.refl,
  linkorder_trans := @list.subset.trans _,
  link_linkorder := λl1 l2 l h,
    let ⟨_, _, C⟩ := link_composite_def_inv h in
    ⟨λx h, C.2 (or.inl h), λx h, C.2 (or.inr h)⟩ }

/- Connections with [build_composite_env]. -/

lemma add_composite_definitions_append (l1 l2 env env'') :
  add_composite_definitions env (l1 ++ l2) = OK env'' ↔
  ∃ env', add_composite_definitions env l1 = OK env' ∧
          add_composite_definitions env' l2 = OK env'' := sorry'

lemma composite_of_def_eq (env id co) :
  composite_consistent env co →
  (env^!id) = none →
  composite_of_def env id (co_su co) (co_members co) (co_attr co) = OK co := sorry'

lemma composite_consistent_unique {env co1 co2} :
  composite_consistent env co1 →
  composite_consistent env co2 →
  co_su co1 = co_su co2 →
  co_members co1 = co_members co2 →
  co_attr co1 = co_attr co2 →
  co1 = co2 := sorry'

lemma composite_of_def_stable {env env'}
  (ext : ∀ id co, (env^!id) = some co → (env'^!id) = some co)
  {id su m a co}
  (hn : (env'^!id) = none)
  (ce : composite_of_def env id su m a = OK co) :
  composite_of_def env' id su m a = OK co := sorry'

def link_add_composite_definitions {l0 env0}
  (hl0 : build_composite_env l0 = OK env0) :
  ∀ {l env1 env1' env2}
  (acd : add_composite_definitions env1 l = OK env1')
  (agree1 : ∀ id co, (env1^!id) = some co → (env2^!id) = some co)
  (agree0 : ∀ id co, (env0^!id) = some co → (env2^!id) = some co)
  (agree2 : ∀ id : ident, (env2^!id) = if id ∈ l0.map name_composite_def then env0^!id else env1^!id)
  (uniq : ∀ cd1 ∈ l0, ∀ cd2 ∈ l, name_composite_def cd2 = name_composite_def cd1 → cd2 = cd1),
  {env2' // add_composite_definitions env2 (filter_redefs l0 l) = OK env2' ∧
    (∀ (id : ident) co, (env1'^!id) = some co → (env2'^!id) = some co) ∧
    (∀ (id : ident) co, (env0^!id) = some co → (env2'^!id) = some co)} :=
begin
  dsimp [filter_redefs], intro l, induction l with co l IH; intros,
  { note : OK env1 = OK env1' := acd, injection this with this,
    rw -this, exact ⟨env2, rfl, agree1, agree0⟩ },
  cases co with id su m a,
  simp [add_composite_definitions] at acd,
  revert acd,
  ginduction composite_of_def env1 id su m a with h co; intro,
  { by_cases name_composite_def ⟨id, su, m, a⟩ ∉ list.map name_composite_def l0 with hel;
    simp [hel, list.filter, add_composite_definitions];
    simp [name_composite_def] at hel,
    { note i2 := agree2 id,
      simp [name_composite_def, hel] at i2,
      exact let ⟨env2', _⟩ := @IH _ _ (PTree.set id co env2) acd sorry' sorry' sorry' sorry' in
      ⟨env2', sorry'⟩
    },
    { note i2 := agree2 id,
      simp [name_composite_def, decidable.by_contradiction hel] at i2,
      exact let ⟨env2', _⟩ := @IH _ _ env2 acd sorry' sorry' sorry' sorry' in
      ⟨env2', sorry'⟩ } },
  { note := (acd : error _ = OK _), contradiction }
end

def link_build_composite_env {l1 l2 l env1 env2}
  (hl1 : build_composite_env l1 = OK env1)
  (hl2 : build_composite_env l2 = OK env2)
  (hl : link l1 l2 = some l) :
  {env // build_composite_env l = OK env ∧
    (∀ (id : ident) co, (env1^!id) = some co → (env^!id) = some co) ∧
    (∀ (id : ident) co, (env2^!id) = some co → (env^!id) = some co)} :=
let ⟨A, B, C⟩ := link_composite_def_inv hl in
let ⟨env, P, Q, R⟩ := begin
  apply link_add_composite_definitions,
  { exact hl1 },
  { exact hl2 },
  { intros, rw PTree.gempty at a, contradiction },
  { intros, assumption },
  { intros,
    by_cases (id ∈ list.map name_composite_def l1) with hel; simp [hel],
    { rw PTree.gempty, exact sorry' } },
  { assumption }
end in
⟨env, sorry', R, Q⟩

/- ** Linking function definitions -/

def link_fundef {F : Type} : fundef F → fundef F → option (fundef F)
| (Internal _) (Internal _) := none
| (External ef1 targs1 tres1 cc1) (External ef2 targs2 tres2 cc2) :=
    if ef1 = ef2 ∧ targs1 = targs2 ∧ tres1 = tres2 ∧ cc1 = cc2
    then some (External ef1 targs1 tres1 cc1)
    else none
| (Internal f) (External (EF_external id sg) targs tres cc) := some (Internal f)
| (Internal f) (External _ targs tres cc) := none
| (External (EF_external id sg) targs tres cc) (Internal f) := some (Internal f)
| (External _ targs tres cc) (Internal f) := none

inductive linkorder_fundef {F : Type} : fundef F → fundef F → Prop
| refl (fd) : linkorder_fundef fd fd
| ext_int (f id sg targs tres cc) :
  linkorder_fundef (External (EF_external id sg) targs tres cc) (Internal f)

instance Linker_fundef (F: Type) : linker (fundef F) :=
{ link := link_fundef,
  linkorder := linkorder_fundef,
  linkorder_refl := linkorder_fundef.refl,
  linkorder_trans := λ x y z h1 h2, begin
    induction h1, exact h2,
    revert h2, generalize2 (Internal f) If hif, intro h2,
    induction h2,
    { rw -hif, apply linkorder_fundef.ext_int },
    { contradiction }
  end,
  link_linkorder := sorry' }

theorem link_fundef_either {F : Type} {f1 f2 f : fundef F} : link f1 f2 = some f → f = f1 ∨ f = f2 := sorry'

/- ** Linking programs -/

def lift_option {A : Type} : Π (opt : option A), psum { x // opt = some x } (opt = none)
| (some x) := psum.inl ⟨x, rfl⟩
| none := psum.inr rfl

def link_program {F} (p1 p2 : program F) : option (program F) :=
match link (program_of_program p1) (program_of_program p2) with
| none := none
| some p :=
  match _, rfl : ∀ o, link p1.types p2.types = o → _ with
  | none, _ := none
  | some typs, EQ :=
    let ⟨env, P, Q⟩ := link_build_composite_env p1.comp_env_eq p2.comp_env_eq EQ in
    some { defs := p.defs,
           public := p.public,
           main := p.main,
           types := typs,
           comp_env := env,
           comp_env_eq := P }
  end
end

def linkorder_program {F} (p1 p2: program F) : Prop :=
     linkorder (program_of_program p1) (program_of_program p2)
  ∧ ∀ id co, (p1.comp_env^!id) = some co → (p2.comp_env^!id) = some co

instance linker_program (F) : linker (program F) :=
{ link := link_program,
  linkorder := linkorder_program,
  linkorder_refl := λx, ⟨@linker.linkorder_refl _ _ _, λid co h, h⟩,
  linkorder_trans := λx y z ⟨p1, a1⟩ ⟨p2, a2⟩, ⟨linker.linkorder_trans p1 p2,
    λid co, a2 id co ∘ a1 id co⟩,
  link_linkorder := sorry' }

/- ** Commutation between linking and program transformations -/

section link_match_program

parameters {F G : Type}.
parameter match_fundef : fundef F → fundef G → Prop

variable link_match_fundef : ∀ {f1 tf1 f2 tf2 f},
  link f1 f2 = some f →
  match_fundef f1 tf1 → match_fundef f2 tf2 →
  ∃ tf, link tf1 tf2 = some tf ∧ match_fundef f tf.

def match_program (p : program F) (tp : program G) : Prop :=
@linking.match_program _ type _ type _ _ (λctx f tf, match_fundef f tf) eq p tp ∧
tp.types = p.types

theorem link_match_program {p1 p2 tp1 tp2 p} :
  link p1 p2 = some p → match_program p1 tp1 → match_program p2 tp2 →
  ∃ tp, link tp1 tp2 = some tp ∧ match_program p tp := sorry'

end link_match_program

end ctypes


import GMLInit.Data.Basic
import GMLInit.Data.Equiv
import GMLInit.Data.Ord
import GMLInit.Meta.Basic
import GMLInit.Meta.Decidable
import GMLInit.Meta.Relation

namespace Index

instance {α} (a : α) (as : List α) : Inhabited (Index (a :: as)) := ⟨head⟩

protected abbrev recNilOn {α} {motive : Index ([]:List α) → Sort _} (i : Index ([]:List α)) : motive i := nomatch i

protected abbrev casesNilOn {α} {motive : Index ([]:List α) → Sort _} (i : Index ([]:List α)) : motive i := nomatch i

lemma val_head {α} (a : α) (as : List α) : (@head α a as).val = a := rfl

lemma val_tail {α} (a : α) (as : List α) (i : Index as) : (@tail α a as i).val = i.val := rfl

lemma val_ndrec {xs ys : List α} (i : Index xs) : (h : xs = ys) → val (h ▸ i : Index ys) = i.val | rfl => rfl

protected def compare : Index xs → Index xs → Ordering
| head, head => .eq
| head, tail _ => .lt
| tail _, head => .gt
| tail i, tail j => Index.compare i j

instance instOrd (xs : List α) : Ord (Index xs) := ⟨Index.compare⟩

instance instLinearOrd : (xs : List α) → LinearOrd (Index xs)
| [] => {
  symm := (nomatch .)
  le_trans := (nomatch .)
  eq_strict := (nomatch .)
}
| _::xs => {
  symm := fun
  | head, head => rfl
  | head, tail _ => rfl
  | tail _, head => rfl
  | tail i, tail j => (instLinearOrd xs).symm i j
  le_trans := fun {i j k} hij hjk => match i, j, k, hij, hjk with
  | head, _, head, _, _ => Ordering.noConfusion
  | head, _, tail _, _, _ => Ordering.noConfusion
  | tail _, head, tail _, h, _ => absurd rfl h
  | tail _, tail _, tail _, hij, hjk => (instLinearOrd xs).le_trans hij hjk
  eq_strict := fun {i j} h => match i, j, h with
  | head, head, _ => rfl
  | head, tail _, h => Ordering.noConfusion h
  | tail _, head, h => Ordering.noConfusion h
  | tail _, tail _, h => congrArg tail ((instLinearOrd xs).eq_strict h)
}

instance : LE (Index xs) := ⟨fun i j => Ord.compare i j ≠ .gt⟩

instance : LT (Index xs) := ⟨fun i j => Ord.compare i j = .lt⟩

protected def head? {α} : (as : List α) → Option (Index as)
| [] => none
| _::_ => some head

protected def last? {α} : (as : List α) → Option (Index as)
| [] => none
| _::as =>
  match Index.last? as with
  | some i => some (tail i)
  | none => some head

protected def next? {α} : {as : List α} → Index as → Option (Index as)
| _::as, head => Option.map tail (Index.head? as)
| _::_, tail i => Option.map tail (Index.next? i)

protected def pred? {α} : {as : List α} → Index as → Option (Index as)
| _::_, head => none
| _::_, tail i =>
  match Index.pred? i with
  | some i => some (tail i)
  | none => some head

protected def find? {α} : {xs : List α} → (p : Index xs → Bool) → Option (Index xs)
| [], _ => none
| _::_, p =>
  match p head, Index.find? (λ i => p (tail i)) with
  | true, _ => some head
  | false, some i => some (tail i)
  | false, none => none

theorem find_some {α} {xs : List α} {p : Index xs → Bool} (i : Index xs) : Index.find? p = some i → p i = true := by
  induction xs with
  | nil => cases i
  | cons x xs ih =>
    intro h
    clean unfold Index.find? at h
    clean at h
    split at h
    next hh => injection h with h; rw [←h, hh]
    next ht => injection h with h; rw [←h, ih _ ht]
    next => contradiction

theorem find_none {α} {xs : List α} {p : Index xs → Bool} (i : Index xs) : Index.find? p = none → p i = false := by
  induction xs with
  | nil => cases i
  | cons x xs ih =>
    intro h
    clean unfold Index.find? at h
    clean at h
    split at h
    next => contradiction
    next => contradiction
    next hh ht =>
      cases i with
      | head => exact hh
      | tail i => exact ih _ ht

def search {α} {xs : List α} {p : Index xs → Prop} [DecidablePred p] (h : ∃ i, p i) : Index xs :=
  match hi : Index.find? λ i => p i with
  | some i => i
  | none => absurd h $ by
    intro ⟨j, hj⟩
    have := find_none j hi
    rw [decide_eq_true hj] at this
    contradiction

theorem search_prop {α} {xs : List α} {p : Index xs → Prop} [DecidablePred p] (h : ∃ i, p i) : p (search h) := by
  clean unfold search
  split
  next h =>
    apply of_decide_eq_true
    exact find_some _ h
  next f =>
    absurd h
    intro ⟨j, hj⟩
    have := find_none j f
    rw [decide_eq_true hj] at this
    contradiction

theorem search_eq {α} {xs : List α} {p q : Index xs → Prop} [ip : DecidablePred p] [iq : DecidablePred q] {hp : ∃ i, p i} {hq : ∃ j, q j}  (h : p = q) : search hp = search hq := by
  cases h
  cases Subsingleton.elim ip iq
  cases Subsingleton.elim hp hq
  rfl

theorem search_ext {α} {xs : List α} {p q : Index xs → Prop} [DecidablePred p] [DecidablePred q] {hp : ∃ i, p i} {hq : ∃ j, q j} : (∀ i, p i ↔ q i) → search hp = search hq := by
  intro h
  apply search_eq
  funext i
  exact propext (h i)

@[inline]
def toNatTR {α} {xs : List α} (i : Index xs) : Nat :=
  let rec loop : {xs : List α} → Index xs → Nat → Nat
  | _, .head, n => n
  | _, .tail i, n => loop i (n+1)
  loop i 0

@[implemented_by toNatTR]
protected def toNat {α} : {xs : List α} → (i : Index xs) → Nat
| _, head => 0
| _, tail i => Index.toNat i + 1

theorem toNat_lt_length {α} {xs : List α} (i : Index xs) : i.toNat < xs.length := by
  induction xs with
  | nil => cases i
  | cons x xs ih =>
    cases i with
    | head =>
      exact Nat.zero_lt_succ ..
    | tail i =>
      apply Nat.succ_lt_succ
      exact ih ..

protected abbrev toFin {α} {xs : List α} (i : Index xs) : Fin xs.length := ⟨i.toNat, i.toNat_lt_length⟩

def ofFinTR {α} {xs : List α} (i : Fin xs.length) : Index xs :=
  let rec loop : {xs ys : List α} → Sum (Fin xs.length) (Index ys) → Index (List.reverseAux xs ys)
  | [], _, .inr i => i
  | _ :: _, _, .inr i => loop (ys:=_::_) (.inr (.tail i))
  | _ :: _, _, .inl ⟨0, _⟩ => loop (ys:=_::_) (.inr .head)
  | _ :: _, _, .inl ⟨i+1, hi⟩ => loop (ys:=_::_) (.inl ⟨i, Nat.lt_of_succ_lt_succ hi⟩)
  xs.reverse_reverse ▸ loop (ys:=[]) (.inl ⟨i.val, xs.length_reverse.symm ▸ i.isLt⟩)

@[implemented_by ofFinTR]
protected def ofFin {α} : {xs : List α} → Fin xs.length → Index xs
| _::_, ⟨0,_⟩ => head
| _::_, ⟨i+1,h⟩ => tail (Index.ofFin ⟨i, Nat.lt_of_succ_lt_succ h⟩)

theorem ofFin_toFin {α} {xs : List α} (i : Index xs) : Index.ofFin i.toFin = i := by
  induction xs with
  | nil => cases i
  | cons x xs ih =>
    cases i with
    | head => rfl
    | tail i =>
      apply congrArg tail
      exact ih ..

theorem toNat_ofFin {α} {xs : List α} (i : Fin xs.length) : (Index.ofFin i).toNat = i.val := by
  induction xs with
  | nil => cases i; contradiction
  | cons x xs ih =>
    match i with
    | ⟨0,_⟩ => rfl
    | ⟨i+1,h⟩ =>
      apply congrArg Nat.succ
      rw [ih]; rfl

theorem toFin_ofFin {α} {xs : List α} (i : Fin xs.length) : (Index.ofFin i).toFin = i := by
  apply Fin.eq_of_val_eq
  apply toNat_ofFin

def equivFin {α} (xs : List α) : Equiv (Index xs) (Fin xs.length) where
  fwd := Index.toFin
  rev := Index.ofFin
  spec {_ _} := by
    constr
    · intro | rfl => exact ofFin_toFin ..
    · intro | rfl => exact toFin_ofFin ..

theorem val_ofFin_eq_get {α} (xs : List α) (i : Fin xs.length) : (Index.ofFin i).val = xs.get i := by
  induction xs with
  | nil => cases i; contradiction
  | cons x xs ih =>
    match i with
    | ⟨0, _⟩ => rfl
    | ⟨i+1, hi⟩ =>
      unfold Index.ofFin
      rw [val_tail, ih]
      rfl

end Index


import Lbar.ext_preamble

noncomputable theory

universes u v

open opposite category_theory category_theory.limits
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r < 1)] [fact (r' < 1)]

open bounded_homotopy_category

variables (BD : breen_deligne.data)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]

def ExtQprime_iso_aux_system_obj_aux' (X : Profinite.{u}) :
  Ab.ulift.{u+1}.obj
    ((forget₂ SemiNormedGroup Ab).obj
      (SemiNormedGroup.Completion.obj ((SemiNormedGroup.LocallyConstant.obj V).obj (op X)))) ≅
  (forget₂ SemiNormedGroup.{u+1} Ab.{u+1}).obj
    (SemiNormedGroup.Completion.obj
      ((SemiNormedGroup.LocallyConstant.obj (SemiNormedGroup.ulift.{u+1}.obj V)).obj (op X))) :=
begin
  refine add_equiv.to_AddCommGroup_iso _,
  refine add_equiv.ulift.trans _,
  refine add_equiv.mk _ _ _ _ _,
  { refine normed_group_hom.completion _,
    refine locally_constant.map_hom _,
    refine { bound' := ⟨1, λ v, _⟩, .. add_equiv.ulift.symm },
    rw one_mul, exact le_rfl },
  { refine uniform_space.completion.map _,
    refine locally_constant.map_hom _,
    refine { bound' := ⟨1, λ v, _⟩, .. add_equiv.ulift },
    rw one_mul, exact le_rfl },
  { erw [function.left_inverse_iff_comp, uniform_space.completion.map_comp],
    { have : ulift.down.{u+1} ∘ ulift.up.{u+1} = (id : V → V) := rfl,
      erw [locally_constant.map_comp, this, locally_constant.map_id, uniform_space.completion.map_id] },
    { apply normed_group_hom.uniform_continuous, },
    { apply normed_group_hom.uniform_continuous, } },
  { erw [function.right_inverse_iff_comp, uniform_space.completion.map_comp],
    { have : ulift.up.{u+1 u} ∘ ulift.down.{u+1} = @id (ulift V) := by { ext v, refl },
      erw [locally_constant.map_comp, this, locally_constant.map_id, uniform_space.completion.map_id] },
    { apply normed_group_hom.uniform_continuous, },
    { apply normed_group_hom.uniform_continuous, } },
  { intros x y, apply normed_group_hom.map_add, }
end
.

attribute [simps] equiv.ulift add_equiv.ulift

lemma SemiNormedGroup.forget₂_Ab_map {V W : SemiNormedGroup} (f : V ⟶ W) :
  (forget₂ SemiNormedGroup Ab).map f = f.to_add_monoid_hom :=
rfl

lemma SemiNormedGroup.forget₂_Ab_obj (V : SemiNormedGroup) :
  (forget₂ SemiNormedGroup Ab).obj V = AddCommGroup.of V :=
rfl

set_option pp.universes true

--jmc: is this helpful??
@[reassoc]
lemma ExtQprime_iso_aux_system_obj_aux'_natural (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (ExtQprime_iso_aux_system_obj_aux' V Y).hom ≫
    (forget₂ _ _).map (SemiNormedGroup.Completion.map ((SemiNormedGroup.LocallyConstant.obj _).map f.op)) =
    Ab.ulift.map ((forget₂ _ _).map (SemiNormedGroup.Completion.map ((SemiNormedGroup.LocallyConstant.obj _).map f.op))) ≫
 (ExtQprime_iso_aux_system_obj_aux' V X).hom :=
begin
  ext1 ⟨φ⟩, simp only [comp_apply],
  dsimp only [ExtQprime_iso_aux_system_obj_aux', add_equiv.to_AddCommGroup_iso,
    add_equiv.trans_apply, add_equiv.coe_to_add_monoid_hom, add_equiv.coe_mk,
    Ab.ulift_map_apply,
    SemiNormedGroup.forget₂_Ab_map, SemiNormedGroup.forget₂_Ab_obj,
    AddCommGroup.coe_of],
  apply uniform_space.completion.induction_on φ; clear φ,
  { refine @is_closed_eq _ _ _ _ (id _) _ _ _ _,
    { dsimp [SemiNormedGroup.Completion_obj, SemiNormedGroup.LocallyConstant_obj_obj],
      apply_instance },
    { apply uniform_space.completion.continuous_map.comp uniform_space.completion.continuous_map },
    { apply uniform_space.completion.continuous_map.comp,
      dsimp only [Ab.ulift, add_monoid_hom.coe_mk, add_equiv.ulift_apply,
        equiv.to_fun_as_coe, equiv.ulift_apply],
      apply uniform_space.completion.continuous_map } },
  { intros φ,
    dsimp only [Ab.ulift, add_monoid_hom.coe_mk, add_equiv.ulift_apply,
      equiv.to_fun_as_coe, equiv.ulift_apply,
      SemiNormedGroup.LocallyConstant_obj_map,
      SemiNormedGroup.Completion_map],
    erw [normed_group_hom.completion_coe, normed_group_hom.completion_coe,
      normed_group_hom.completion_coe, normed_group_hom.completion_coe],
    congr' 1,
    dsimp only [locally_constant.comap_hom_apply, locally_constant.map_hom_apply],
    erw [locally_constant.comap_map],
    exact f.continuous, }
end
.

open category_theory.preadditive

lemma FreeAb_naturality_helper {C 𝓐 : Type*} [category C] [category 𝓐] [preadditive 𝓐]
  (F G : FreeAb C ⥤ 𝓐) [F.additive] [G.additive]
  (η : ∀ X : FreeAb C, F.obj X ⟶ G.obj X)
  (hη : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), F.map ((FreeAb.of_functor _).map f) ≫ η _ = η _ ≫ G.map ((FreeAb.of_functor _).map f))
  {X Y : FreeAb C} (f : X ⟶ Y) :
  F.map f ≫ η Y = η X ≫ G.map f :=
begin
  change right_comp _ (η Y) (F.map_add_hom f) = left_comp _ (η X) (G.map_add_hom f),
  rw [← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_apply], congr' 1, clear f,
  ext1 f, cases X, cases Y, exact hη f,
end

lemma ExtQprime_iso_aux_system_obj_aux_aux (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (LCC_iso_Cond_of_top_ab.{u} V).inv.app (op.{u+2} Y) ≫
  (forget₂.{u+1 u+1 u u u} SemiNormedGroup.{u} Ab.{u}).map
    (SemiNormedGroup.Completion.{u}.map
    ((SemiNormedGroup.LocallyConstant.{u u}.obj V).map f.op)) =
  (Condensed.of_top_ab.presheaf _).map f.op ≫
  (LCC_iso_Cond_of_top_ab V).inv.app (op X) :=
begin
  simp only [← nat_iso.app_inv, iso.inv_comp_eq],
  simp only [← category.assoc, iso.eq_comp_inv],
  ext1 t, dsimp [forget₂, has_forget₂.forget₂,
    LCC_iso_Cond_of_top_ab, LCC_iso_Cond_of_top_ab_add_equiv] at t ⊢,
  simp only [comp_apply, normed_group_hom.coe_to_add_monoid_hom,
    add_equiv.coe_to_add_monoid_hom, add_equiv.coe_mk],
  dsimp only [Condensed.of_top_ab.presheaf, add_monoid_hom.mk'_apply],
  ext x,
  simp only [continuous_map.comp_apply],
  apply uniform_space.completion.induction_on t; clear t,
  { refine is_closed_eq _ _,
    { have h1 : continuous (λ q : C(X,V), q x) := continuous_map.continuous_eval_const.{u u} x,
      have h2 : continuous (uniform_space.completion.extension.{u u}
        locally_constant.to_continuous_map.{u u}) := uniform_space.completion.continuous_extension,
      have h3 := (locally_constant.comap_hom.{u u u} f f.continuous).completion.continuous,
      refine (h1.comp h2).comp h3,
      apply_instance },
    { let t := _, change continuous t,
      have ht : t = _ ∘ uniform_space.completion.extension
        (locally_constant.to_continuous_map.{u u}),
      rotate 2,
      { intros q, exact q (f x) },
      { refl },
      rw ht, clear ht t,
      apply continuous.comp,
      exact continuous_map.continuous_eval_const.{u u} (f x),
      exact uniform_space.completion.continuous_extension.{u u} } },
  { intros a,
    simp only [normed_group_hom.completion_coe,
      locally_constant.comap_hom_apply, quiver.hom.unop_op],
    erw [uniform_space.completion.extension_coe],
    erw [uniform_space.completion.extension_coe],
    unfold locally_constant.comap,
    classical,
    erw dif_pos, refl,
    exact f.continuous,
    exact locally_constant.to_continuous_map_uniform_continuous.{u} Y ↥V,
    exact locally_constant.to_continuous_map_uniform_continuous.{u} X ↥V },
end

def ExtQprime_iso_aux_system_obj_aux :
  ((CLC (SemiNormedGroup.ulift.{u+1}.obj V)).right_op.map_FreeAb ⋙
         FreeAb.eval SemiNormedGroupᵒᵖ) ⋙
    (forget₂ SemiNormedGroup Ab).op ≅
  (freeCond.map_FreeAb ⋙ FreeAb.eval (Condensed.{u} Ab.{u+1})) ⋙
    (preadditive_yoneda.obj V.to_Cond).right_op :=
begin
  refine nat_iso.of_components _ _,
  { intro X,
    dsimp only [functor.comp_obj, functor.right_op, functor.op_obj, FreeAb.eval,
      functor.map_FreeAb],
    refine iso.op _,
    refine (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab _ _) ≪≫ _,
    let e := (Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).app (op X.as),
    refine e.symm ≪≫ (ExtQprime_iso_aux_system_obj_aux' V X.as), },
  { intros X Y f,
    apply FreeAb_naturality_helper, clear f X Y, intros X Y f,
    dsimp only [id.def, iso.trans_hom, iso.op_hom, op_comp, iso.symm_hom, functor.map_iso_inv,
      functor.comp_map, functor.right_op_map, functor.op_map, iso.app_inv,
      FreeAb.eval, functor.map_FreeAb, FreeAb.of_functor],
    simp only [category.assoc, ← op_comp], congr' 1,
    simp only [free_abelian_group.map_of_apply, free_abelian_group.lift.of, id.def,
      functor.right_op_map, quiver.hom.unop_op],
    erw ← preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural'_assoc,
    congr' 1,
    dsimp [Condensed_LCC_iso_of_top_ab],
    erw ExtQprime_iso_aux_system_obj_aux'_natural,
    simp only [← category.assoc], congr' 1,
    rw ← Ab.ulift.map_comp,
    rw ExtQprime_iso_aux_system_obj_aux_aux,
    ext, refl }
end

/-- Hom(X,A) -/
def hom_complex_int (X : homological_complex (Condensed.{u} Ab.{u+1})
  (complex_shape.up ℤ)) (A : Condensed.{u} Ab.{u+1}) :
  homological_complex Ab.{u+1} (complex_shape.up ℤ).symm :=
(((preadditive_yoneda.obj A).map_homological_complex _).obj X.op)

def hom_complex_nat (X : homological_complex (Condensed.{u} Ab.{u+1})
  (complex_shape.down ℕ)) (A : Condensed.{u} Ab.{u+1}) :
  homological_complex Ab.{u+1} (complex_shape.down ℕ).symm :=
(((preadditive_yoneda.obj A).map_homological_complex _).obj X.op)

def embed_hom_complex_nat_iso (X : homological_complex (Condensed.{u} Ab.{u+1})
  (complex_shape.down ℕ)) (A : Condensed.{u} Ab.{u+1}) :
  hom_complex_int ((homological_complex.embed
    complex_shape.embedding.nat_down_int_up).obj X) A ≅
  (homological_complex.embed complex_shape.embedding.nat_up_int_down).obj
  (hom_complex_nat X A) :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| int.of_nat 0 := iso.refl _
| int.of_nat (i+1) := is_zero.iso (functor.map_is_zero _ (is_zero_zero _).op) (is_zero_zero _)
| -[1+i] := iso.refl _
end)
begin
  rintro i (j|(_|j)) (rfl : _ = _),
  { apply is_zero.eq_of_src,
    refine functor.map_is_zero _ _,
    dsimp, apply is_zero.op, exact is_zero_zero _ },
  { refine (category.id_comp _).trans (category.comp_id _).symm, },
  { refine (category.id_comp _).trans (category.comp_id _).symm, },
end

/-
lemma embed_hom_complex_nat_iso_homology_iso (X : homological_complex (Condensed.{u} Ab.{u+1})
  (complex_shape.down ℕ)) (A : Condensed.{u} Ab.{u+1}) (n : ℕ) :
  (homology_functor _ _ (-(n : ℤ))).map (embed_hom_complex_nat_iso X A).hom ≫
  (homological_complex.homology_embed_nat_iso _
    complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff
    n (-(n : ℤ)) (by { cases n; refl })).app _
  = _
-/

/-
-- OLD construction of ExtQprime_iso_aux_system_obj
begin
  refine (homology_functor _ _ (-n:ℤ)).map_iso _ ≪≫ _,
  { let C := ((preadditive_yoneda.obj V.to_Cond).right_op.map_homological_complex _).obj
      (((QprimeFP_nat r' BD κ M).obj c)),
    exact ((homological_complex.embed complex_shape.embedding.nat_up_int_down).obj C.unop), },
  { refine _ ≪≫ embed_unop.app (op (((preadditive_yoneda_obj V.to_Cond ⋙ forget₂ _ _).right_op.map_homological_complex
      (complex_shape.down ℕ)).obj ((QprimeFP_nat r' BD κ M).obj c))),
    dsimp,
    refine (homological_complex.unop_functor.right_op.map_iso _).unop,
    symmetry, refine (map_homological_complex_embed _).app _, },
  refine (homological_complex.homology_embed_nat_iso _
    complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff
    n (-n) (by { cases n; refl })).app _ ≪≫ (homology_functor _ _ _).map_iso _,
  refine hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c
end
-/

def hom_complex_QprimeFP_nat_iso_aux_system (c : ℝ≥0) :
  hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c) V.to_Cond ≅
  (aux_system.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).to_Ab.obj (op.{1} c) :=
begin
  refine _ ≪≫ forget₂_unop.app _,
  let φ : op (((preadditive_yoneda.obj V.to_Cond).right_op.map_homological_complex (complex_shape.down ℕ)).obj
  ((QprimeFP_nat r' BD κ M).obj c)) ≅ _ := _,
  refine homological_complex.unop_functor.map_iso φ,
  refine ((category_theory.nat_iso.map_homological_complex
    (ExtQprime_iso_aux_system_obj_aux V) _).app ((breen_deligne.FPsystem r' BD _ κ).obj c)).op,
end

def ExtQprime_iso_aux_system_obj (c : ℝ≥0) (n : ℕ) :
  ((Ext n).obj (op $ (QprimeFP r' BD κ M).obj c)).obj ((single _ 0).obj V.to_Cond) ≅
  ((aux_system r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ).to_AbH n).obj (op c) :=
Ext_compute_with_acyclic _ _ (ExtQprime_iso_aux_system_aux r' BD κ M V c) _ ≪≫
begin
  refine (homology_functor _ _ (-n:ℤ)).map_iso
    (embed_hom_complex_nat_iso _ _) ≪≫ _,
  refine (homological_complex.homology_embed_nat_iso _
    complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff
    n (-n) (by { cases n; refl })).app _ ≪≫ (homology_functor _ _ _).map_iso _,
  refine hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c
end

attribute [reassoc] Ext_compute_with_acyclic_naturality

def cofan_point_iso_colimit {α : Type (u+1)}
  (X : α → bounded_homotopy_category (Condensed.{u} Ab.{u+1}))
  [bounded_homotopy_category.uniformly_bounded X] :
  (bounded_homotopy_category.cofan X).X ≅
  ∐ X :=
(bounded_homotopy_category.is_colimit_cofan X).cocone_point_unique_up_to_iso
  (colimit.is_colimit _)

variables (ι : ulift.{u+1} ℕ → ℝ≥0) (hι : monotone ι)

instance sigma_Qprime_int_bounded_above :
  ((homotopy_category.quotient (Condensed Ab) (complex_shape.up ℤ)).obj
    (∐ λ (k : ulift ℕ), (QprimeFP_int r' BD κ M).obj (ι k))).is_bounded_above :=
begin
  refine ⟨⟨1, _⟩⟩,
  intros a ha,
  refine is_zero.of_iso _ (homotopy_category.coproduct_iso _ _),
  apply category_theory.is_zero_colimit,
  intro,
  exact chain_complex.bounded_by_one _ _ ha,
end
.

def coproduct_shift (A : Type u)
  [category.{v} A]
  [abelian A]
  [has_coproducts A]
  (X : ulift.{v} ℕ → bounded_homotopy_category A)
  [uniformly_bounded X]
  (e : X ⟶ (λ i, X (ulift.up $ ulift.down i + 1))) :
  ∐ X ⟶ ∐ X :=
begin
  apply sigma.desc,
  intros i,
  refine _ ≫ sigma.ι _ (ulift.up $ ulift.down i + 1),
  refine e _,
end

@[reassoc]
lemma Ext_coproduct_iso_naturality_shift
  (A : Type u)
  [category.{v} A]
  [abelian A]
  [enough_projectives A]
  [has_coproducts A]
  [AB4 A]
  (X : ulift.{v} ℕ → bounded_homotopy_category A)
  [uniformly_bounded X]
  (e : X ⟶ (λ i, X (ulift.up $ ulift.down i + 1)))
  (i : ℤ) (Y) :
  ((Ext i).map (coproduct_shift _ X e).op).app Y ≫
  (Ext_coproduct_iso X _ _).hom =
  (Ext_coproduct_iso _ _ _).hom ≫
  pi.lift (λ j, pi.π _ (ulift.up (ulift.down j + 1)) ≫
    ((Ext i).map (e _).op).app Y) :=
begin
  dsimp only [Ext_coproduct_iso, Ext, Ext0, Ext_iso, functor.comp_map, whiskering_left,
    whisker_left, iso.trans_hom, functor.map_iso, preadditive_yoneda_coproduct_iso,
    functor.flip, pi_iso, as_iso, preadditive_yoneda_coproduct_to_product],
  simp only [category.assoc],
  simp only [quiver.hom.unop_op, iso.op_hom, replacement_iso_hom, iso.op_inv,
    replacement_iso_inv, iso.symm_mk],
  apply limit.hom_ext,
  intros j,
  simp only [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π_assoc],
  simp only [← functor.map_comp, ← op_comp],
  congr' 2,
  simp only [category.assoc],
  apply lift_ext (∐ X).π, swap, apply_instance,
  dsimp [quiver.hom.unop_op],
  simp only [category.assoc, lift_lifts, lift_lifts_assoc],
  dsimp [uniform_π, coproduct_shift],
  simp only [colimit.ι_desc_assoc, cofan.mk_ι_app, category.assoc, colimit.ι_desc,
    lift_lifts_assoc],
end