import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))),
  assume hA : is_open_cover A,
  have h1 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ n : ℕ, n < m → x ∉ closure (ball (0 : euclidean_space ℝ (fin n)) n), from sorry,

  have h2 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ n : ℕ, n < m → x ∉ ball (0 : euclidean_space ℝ (fin n)) n, from sorry,

  have h3 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∃ Cₘ : set (euclidean_space ℝ (fin n)), x ∈ Cₘ ∧ Cₘ ⊆ ⋃₀ A ∧ ∀ y ∈ Cₘ, y ∈ ball (0 : euclidean_space ℝ (fin n)) m ∧ y ∉ ball (0 : euclidean_space ℝ (fin n)) (m - 1), from sorry,

  show ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite_cover C ∧ A ≤ C, from sorry,
end

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (h1 : is_open U),
  have h2 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = (⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1), from sorry,
  have h3 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h4 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h5 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h6 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h7 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h8 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h9 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h10 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h11 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h12 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h13 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h14 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h15 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h16 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h17 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h18 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h19 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h20 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h21 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h22 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h23 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h24 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h25 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h26 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_open_ball x 1, from sorry,
  have h27 : ∃ (K : set (euclidean_space ℝ (fin n))), is_compact K ∧ U = ⋃ (x : (euclidean_space ℝ (fin n))) (h2 : x ∈ K), is_
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hA2 : ⋃₀ A = univ),

  let C0 : set (euclidean_space ℝ (fin n)) := {},
  let B0 : set (euclidean_space ℝ (fin n)) := {},
  let Bm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, {x | ∃ (y : euclidean_space ℝ (fin n)), y ∈ Bm 0 ∧ x ∈ ball (euclidean_space ℝ (fin n)) y m},
  let Cm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, {x | ∃ (y : euclidean_space ℝ (fin n)), y ∈ Bm 0 ∧ x ∈ ball (euclidean_space ℝ (fin n)) y m ∧ y ∉ Bm 0},
  let C : set (euclidean_space ℝ (fin n)) := {x | ∃ (m : ℕ) (y : euclidean_space ℝ (fin n)), y ∈ Bm 0 ∧ x ∈ ball (euclidean_space ℝ (fin n)) y m ∧ y ∉ Bm 0},
  let B : set (euclidean_space ℝ (fin n)) := {x | ∃ (m : ℕ) (y : euclidean_space ℝ (fin n)), y ∈ Bm 0 ∧ x ∈ ball (euclidean_space ℝ (fin n)) y m},

  have hB0 : is_open B0, from sorry,
  have hBm : ∀ m : ℕ, is_open (Bm m), from sorry,
  have hB : is_open B, from sorry,

  have hC0 : is_open C0, from sorry,
  have hCm : ∀ m : ℕ, is_open (Cm m), from sorry,
  have hC : is_open C, from sorry,

end

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (φ : set (euclidean_space ℝ (fin n))),
  assume (h1 : φ = ∅),
  have h2 : φ = ∅, from sorry,
  have h3 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h4 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h5 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h6 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h7 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h8 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h9 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h10 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h11 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h12 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h13 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h14 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h15 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h16 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h17 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h18 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h19 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h20 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h21 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h22 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h23 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h24 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h25 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h26 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h27 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h28 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h29 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h30 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h31 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h32 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h33 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h34 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h35 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h36 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h37 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h38 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h39 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h40 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h41 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h42 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h43 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h44 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h45 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h46 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h47 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h48 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h49 : ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ φ → U = ∅, from sorry,
  have h50 : ∀ (U : set (euclidean_space
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (h1 : A₀ ⊆ A),
  have h2 : is_open (A₀), from sorry,
  have h3 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h4 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h5 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h6 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h7 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h8 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h9 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h10 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h11 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h12 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h13 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h14 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h15 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h16 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h17 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h18 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h19 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h20 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h21 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h22 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h23 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h24 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h25 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h26 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h27 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h28 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h29 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h30 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h31 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h32 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h33 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h34 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h35 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h36 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h37 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h38 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h39 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h40 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h41 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h42 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h43 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h44 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h45 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h46 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h47 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h48 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ (B_m), from sorry,
  have h49
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hA_cover : ⟪A⟫ = ⊤),

  let B0 : set (euclidean_space ℝ (fin n)) := ∅,
  let B : ℕ → set (euclidean_space ℝ (fin n)) := λ m, (ball (0 : ℝ ^ n) m),
  let Bbar : ℕ → set (euclidean_space ℝ (fin n)) := λ m, closure (B m),

  let Bbar_compact : ℕ → Prop := λ m, compact (Bbar m),
  let Bbar_compact_true : ∀ m : ℕ, Bbar_compact m := by {
    assume m : ℕ,
    have h1 : compact (Bbar m), from sorry,
    show Bbar_compact m, from h1,
  },

  let C : ℕ → set (euclidean_space ℝ (fin n)) := λ m, (B m) ∩ (⊤ \ (Bbar (m-1))),
  let C_union : set (euclidean_space ℝ (fin n)) := ⋃ (m : ℕ), (C m),

  let C_union_cover : ⟪C_union⟫ = ⊤ := by {
    have h1 : ⟪C_union⟫ ⊆ ⊤, from by {
      assume x : (euclidean_space ℝ (fin n)),
      assume h1 : x ∈ ⟪C_union⟫,
      have h2 : ∃ m : ℕ, x ∈ (C m), from sorry,
      cases h2 with m h2,
      have h3 : x ∈ (⊤ \ (Bbar (m-1))), from sorry,
      have h4 : x ∈ ⊤, from sorry,
      show x ∈ ⊤, from h4,
    },
    have h2 : ⊤ ⊆ ⟪C_union⟫, from by {
      assume x : (euclidean_space ℝ (fin n)),
      assume h2 : x ∈ ⊤,
      have h3 : ∃ m : ℕ, x ∈ (B m), from sorry,
      cases h3 with m h3,
      have h4 : x ∈ (B m), from h3,
      have h5 : x ∈ (⊤ \ (Bbar (m-1))), from sorry,
      have h6 : x ∈ (C m), from sorry,
      have h7 : x ∈ ⟪C_union⟫, from sorry,
      show x ∈ ⟪C_union⟫, from h7,
    },
    show ⟪C_union⟫ = ⊤, from sorry,
  },

  let C_union_open : is_open C_union := by {
    have h1 : ∀ m : ℕ, is_open (C m), from by {
      assume m : ℕ,
      have h1 : is_open (B m), from sorry,
      have h2 : is_open (⊤ \ (Bbar (m-1))), from sorry,
      have h3 : is_open ((B m) ∩ (⊤ \ (Bbar (m-1)))), from sorry,
      show is_open (C m), from h3,
    },
    have h2 : ∀ m : ℕ, is_open (C m), from h1,
    show is_open C_union, from sorry,
  },

  let C_union_locally_finite : locally_finite_open C_union := by {
    assume x : (euclidean_space ℝ (fin n)),
    assume h1 : x ∈ C_union,
    have h2 : ∃ m : ℕ, x ∈ (C m), from sorry,
    cases h2 with m h2,
    have h3 : x ∈ (C m), from h2,
    have h4 : x ∈ (ball (0 : ℝ ^ n) m), from sorry,
    have h5 : x ∈ (⊤ \ (Bbar (m-1))), from sorry,
    have h6 : x ∈ (Bbar m), from sorry,
    have h7 : x ∈ (closure (Bbar m)), from sorry,
    have h8 : x ∈ (⟪(closure (Bbar m))⟫), from sorry,
    have h9 : ⟪(closure (Bbar m))⟫ ⊆ ⟪(Bbar m)⟫, from sorry,
    have h10 : ⟪(Bbar m)⟫ ⊆ ⟪(B m)⟫, from sorry,
    have h11 : ⟪(closure (Bbar m))⟫ ⊆ ⟪(B m)⟫, from sorry,
    have h12 : ⟪(closure (Bbar m))⟫ ⊆ (B m), from sorry,
    have h13 : ⟪(closure (Bbar m))⟫ ⊆ ((B m) ∩ (⊤ \ (Bbar (m-1)))), from sorry,
    have h14 : ⟪(closure (Bbar m))⟫ ⊆ (C m), from sorry,
    have h15 : ⟪(closure (Bbar m))⟫ ⊆ (⋃ (n : ℕ), (C n)), from sorry,
    have h16 : ∃ m : ℕ, ⟪(closure (Bbar m))⟫ ⊆ (C m), from sorry,
    have h17 : locally_finite_family (λ n : ℕ, ⟪(closure (Bbar n))⟫), from sorry,
    have h18 : locally_finite_open (⋃ (n : ℕ), ⟪(closure (Bbar n))⟫), from sorry,
    show locally_finite_open C_union, from h18,
  },

  show ∃ C_union : set (euclidean_space ℝ (fin n)),
  is_open C_union ∧ locally_finite_open C_union ∧ ⟪C_union⟫ = ⊤,
  from sorry,
end

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
    assume A,
    assume hA : open_cover (euclidean_space ℝ (fin n)) A,
    have h1 : ∀ n : ℕ, ∃ Bn : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bn, from sorry,
    have h2 : ∃ B0 : set (euclidean_space ℝ (fin 0)), ∀ x : euclidean_space ℝ (fin 0), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ B0, from sorry,
    have h3 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h4 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h5 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h6 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h7 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h8 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h9 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h10 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h11 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h12 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h13 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h14 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h15 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h16 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h17 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h18 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h19 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h20 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h21 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h22 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h23 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h24 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ k : ℕ, m ≤ k → x ∈ Bm, from sorry,
    have h25 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), ∃ m :
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
{ open_cover := sorry,
  locally_finite_refinement := sorry,
  locally_finite_refinement_is_open := sorry,
  locally_finite_refinement_covers := sorry,
  locally_finite_refinement_locally_finite := sorry,
}

/--`theorem`
\mathbb{R}^n is locally compact
$\mathbb{R}^n$ is locally compact for all $n$.
`proof`
Let $x \in \mathbb{R}^n$ and let $d = \rVert x \lVert$. Then $B_d(x)$ is compact by the Heine-Borel theorem. So $\mathbb{R}^n$ is locally compact.

QED
-/
theorem  ℝn_locally_compact (n : ℕ) : locally_compact_space (euclidean_space ℝ (fin n)) :=
{ compact_nhds := sorry }

/--`theorem`
\mathbb{R}^n is Hausdorff
$\mathbb{R}^n$ is Hausdorff for all $n$.
`proof`
Let $x, y \in \mathbb{R}^n$ with $x \neq y$. If $x = 0$ or $y = 0$ the result is clear, so we assume $x \neq 0 \neq y$. Let $a = \rVert x \lVert$ and $b = \rVert y \lVert$. Then $x \in B_a(0)$ and $y \in B_b(0)$, and $\bar{B_a(0)} \cap \bar{B_b(0)} = \phi$. So $B_a(0)$ and $B_b(0)$ are disjoint open neighborhoods of $x$ and $y$ in $\mathbb{R}^n$, so $\mathbb{R}^n$ is Hausdorff.

QED
-/
theorem  ℝn_hausdorff (n : ℕ) : hausdorff_space (euclidean_space ℝ (fin n)) :=
{ disjoint_nhds := sorry }
end

/- 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`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Util.ForEachExpr
import Lean.Meta.ForEachExpr
import Lean.Meta.RecursorInfo
import Lean.Meta.Match.Match
import Lean.Meta.Transform
import Lean.Elab.PreDefinition.Basic
namespace Lean.Elab
namespace Structural
open Meta

private def getFixedPrefix (declName : Name) (xs : Array Expr) (value : Expr) : MetaM Nat := do
  let numFixedRef ← IO.mkRef xs.size
  forEachExpr' value fun e => do
    if e.isAppOf declName then
      let args := e.getAppArgs
      numFixedRef.modify fun numFixed => if args.size < numFixed then args.size else numFixed
      for arg in args, x in xs do
        /- We should not use structural equality here. For example, given the definition
           ```
           def V.map {α β} f x x_1 :=
             @V.map.match_1.{1} α (fun x x_2 => V β x) x x_1
               (fun x x_2 => @V.mk₁ β x (f Bool.true x_2))
               (fun e => @V.mk₂ β (V.map (fun b => α b) (fun b => β b) f Bool.false e))
           ```
           The first three arguments at `V.map (fun b => α b) (fun b => β b) f Bool.false e` are "fixed"
           modulo definitional equality.

           We disable to proof irrelevance to be able to use structural recursion on inductive predicates.
           For example, consider the example
           ```
          inductive PList (α : Type) : Prop
          | nil
          | cons : α → PList α → PList α

          infixr:67 " ::: " => PList.cons

          set_option trace.Elab.definition.structural true in
          def pmap {α β} (f : α → β) : PList α → PList β
          | PList.nil => PList.nil
          | a:::as => f a ::: pmap f as
          ```
          The "Fixed" prefix would be 4 since all elements of type `PList α` are definitionally equal.
        -/
        if !(← withoutProofIrrelevance <| withReducible <| isDefEq arg x) then
          -- We continue searching if e's arguments are not a prefix of `xs`
          return true
      return false
    else
      return true
  numFixedRef.get

structure RecArgInfo where
  /- `fixedParams ++ ys` are the arguments of the function we are trying to justify termination using structural recursion. -/
  fixedParams : Array Expr
  ys          : Array Expr  -- recursion arguments
  pos         : Nat         -- position in `ys` of the argument we are recursing on
  indicesPos  : Array Nat   -- position in `ys` of the inductive datatype indices we are recursing on
  indName     : Name        -- inductive datatype name of the argument we are recursing on
  indLevels   : List Level  -- inductice datatype universe levels of the argument we are recursing on
  indParams   : Array Expr  -- inductive datatype parameters of the argument we are recursing on
  indIndices  : Array Expr  -- inductive datatype indices of the argument we are recursing on, it is equal to `indicesPos.map fun i => ys.get! i`
  reflexive   : Bool        -- true if we are recursing over a reflexive inductive datatype

private def getIndexMinPos (xs : Array Expr) (indices : Array Expr) : Nat := do
  let mut minPos := xs.size
  for index in indices do
    match xs.indexOf? index with
    | some pos => if pos.val < minPos then minPos := pos.val
    | _        => pure ()
  return minPos

-- Indices can only depend on other indices
private def hasBadIndexDep? (ys : Array Expr) (indices : Array Expr) : MetaM (Option (Expr × Expr)) := do
  for index in indices do
    let indexType ← inferType index
    for y in ys do
      if !indices.contains y && (← dependsOn indexType y.fvarId!) then
        return some (index, y)
  return none

-- Inductive datatype parameters cannot depend on ys
private def hasBadParamDep? (ys : Array Expr) (indParams : Array Expr) : MetaM (Option (Expr × Expr)) := do
  for p in indParams do
    let pType ← inferType p
    for y in ys do
      if ← dependsOn pType y.fvarId! then
        return some (p, y)
  return none

private def throwStructuralFailed {α} : MetaM α :=
  throwError "structural recursion cannot be used"

structure State where
  /- When compiling structural recursion we use the `brecOn` recursor automatically built by
     the `inductive` command. For an inductive datatype `C`, it has the form
     `C.brecOn As motive is c F`
     where `As` are the inductive datatype parameters, `is` are the inductive datatype indices,
     `c : C As is`, and `F : (js) → (d : C As js) → C.below d → motive d`
     The `C.below d` is used to eliminate recursive applications. We refine its type when we process
     a nested dependent pattern matcher using `MatcherApp.addArg`. See `replaceRecApps` for additional details.
     We store the names of the matcher where we used `MatcherApp.addArg` at `matcherBelowDep`.
     We use this information to generate the auxiliary `_sunfold` definition needed by the smart unfolding
     technique used at WHNF. -/
  matcherBelowDep : NameSet := {}

abbrev M := StateRefT State MetaM

instance {α} : Inhabited (M α) where
  default := throwError "failed"

private def run {α} (x : M α) (s : State := {}) : MetaM (α × State) :=
  StateRefT'.run x s

private def orelse' {α} (x y : M α) : M α := do
  let saveState ← get
  orelseMergeErrors x (do set saveState; y)

private partial def findRecArg {α} (numFixed : Nat) (xs : Array Expr) (k : RecArgInfo → M α) : M α :=
  let rec loop (i : Nat) : M α := do
    if h : i < xs.size then
      let x := xs.get ⟨i, h⟩
      let localDecl ← getFVarLocalDecl x
      if localDecl.isLet then
        throwStructuralFailed
      else
        let xType ← whnfD localDecl.type
        matchConstInduct xType.getAppFn (fun _ => loop (i+1)) fun indInfo us => do
        if !(← hasConst (mkBRecOnName indInfo.name)) then
          loop (i+1)
        else if indInfo.isReflexive && !(← hasConst (mkBInductionOnName indInfo.name)) then
          loop (i+1)
        else
          let indArgs    := xType.getAppArgs
          let indParams  := indArgs.extract 0 indInfo.numParams
          let indIndices := indArgs.extract indInfo.numParams indArgs.size
          if !indIndices.all Expr.isFVar then
            orelse'
              (throwError "argument #{i+1} was not used because its type is an inductive family and indices are not variables{indentExpr xType}")
              (loop (i+1))
          else if !indIndices.allDiff then
            orelse'
              (throwError "argument #{i+1} was not used because its type is an inductive family and indices are not pairwise distinct{indentExpr xType}")
              (loop (i+1))
          else
            let indexMinPos := getIndexMinPos xs indIndices
            let numFixed    := if indexMinPos < numFixed then indexMinPos else numFixed
            let fixedParams := xs.extract 0 numFixed
            let ys          := xs.extract numFixed xs.size
            match ← hasBadIndexDep? ys indIndices with
            | some (index, y) =>
              orelse'
                (throwError "argument #{i+1} was not used because its type is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}")
                (loop (i+1))
            | none =>
              match ← hasBadParamDep? ys indParams with
              | some (indParam, y) =>
                orelse'
                  (throwError "argument #{i+1} was not used because its type is an inductive datatype{indentExpr xType}\nand parameter{indentExpr indParam}\ndepends on{indentExpr y}")
                  (loop (i+1))
              | none =>
                let indicesPos := indIndices.map fun index => match ys.indexOf? index with | some i => i.val | none => unreachable!
                orelse'
                  (mapError
                    (k { fixedParams := fixedParams
                         ys          := ys
                         pos         := i - fixedParams.size
                         indicesPos  := indicesPos
                         indName     := indInfo.name
                         indLevels   := us
                         indParams   := indParams
                         indIndices  := indIndices
                         reflexive := indInfo.isReflexive })
                    (fun msg => m!"argument #{i+1} was not used for structural recursion{indentD msg}"))
                  (loop (i+1))
    else
      throwStructuralFailed
  loop numFixed

private def containsRecFn (recFnName : Name) (e : Expr) : Bool :=
  (e.find? fun e => e.isConstOf recFnName).isSome

private def ensureNoRecFn (recFnName : Name) (e : Expr) : MetaM Expr := do
  if containsRecFn recFnName e then
    Meta.forEachExpr e fun e => do
      if e.isAppOf recFnName then
        throwError "unexpected occurrence of recursive application{indentExpr e}"
    pure e
  else
    pure e

private def throwToBelowFailed {α} : MetaM α :=
  throwError "toBelow failed"

/- See toBelow -/
private partial def toBelowAux (C : Expr) : Expr → Expr → Expr → MetaM Expr
  | belowDict, arg, F => do
    let belowDict ← whnf belowDict
    trace[Elab.definition.structural] "belowDict: {belowDict}, arg: {arg}"
    match belowDict with
    | Expr.app (Expr.app (Expr.const `PProd _ _) d1 _) d2 _ =>
      (do toBelowAux C d1 arg (← mkAppM `PProd.fst #[F]))
      <|>
      (do toBelowAux C d2 arg (← mkAppM `PProd.snd #[F]))
    | Expr.app (Expr.app (Expr.const `And _ _) d1 _) d2 _ =>
      (do toBelowAux C d1 arg (← mkAppM `And.left #[F]))
      <|>
      (do toBelowAux C d2 arg (← mkAppM `And.right #[F]))
    | _ => forallTelescopeReducing belowDict fun xs belowDict => do
      let argArgs := arg.getAppArgs
      unless argArgs.size >= xs.size do throwToBelowFailed
      let n := argArgs.size
      let argTailArgs := argArgs.extract (n - xs.size) n
      let belowDict := belowDict.replaceFVars xs argTailArgs
      match belowDict with
      | Expr.app belowDictFun belowDictArg _ =>
        unless belowDictFun.getAppFn == C do throwToBelowFailed
        unless ← isDefEq belowDictArg arg do throwToBelowFailed
        pure (mkAppN F argTailArgs)
      | _ => throwToBelowFailed

/- See toBelow -/
private def withBelowDict {α} (below : Expr) (numIndParams : Nat) (k : Expr → Expr → MetaM α) : MetaM α := do
  let belowType ← inferType below
  trace[Elab.definition.structural] "belowType: {belowType}"
  belowType.withApp fun f args => do
    let motivePos := numIndParams + 1
    unless motivePos < args.size do throwError "unexpected 'below' type{indentExpr belowType}"
    let pre := mkAppN f (args.extract 0 numIndParams)
    let preType ← inferType pre
    forallBoundedTelescope preType (some 1) fun x _ => do
      let motiveType ← inferType x[0]
      let C ← mkFreshUserName `C
      withLocalDeclD C motiveType fun C =>
        let belowDict := mkApp pre C
        let belowDict := mkAppN belowDict (args.extract (numIndParams + 1) args.size)
        k C belowDict

/-
  `below` is a free variable with type of the form `I.below indParams motive indices major`,
  where `I` is the name of an inductive datatype.

  For example, when trying to show that the following function terminates using structural recursion
  ```lean
  def addAdjacent : List Nat → List Nat
  | []       => []
  | [a]      => [a]
  | a::b::as => (a+b) :: addAdjacent as
  ```
  when we are visiting `addAdjacent as` at `replaceRecApps`, `below` has type
  `@List.below Nat (fun (x : List Nat) => List Nat) (a::b::as)`
  The motive `fun (x : List Nat) => List Nat` depends on the actual function we are trying to compute.
  So, we first replace it with a fresh variable `C` at `withBelowDict`.
  Recall that `brecOn` implements course-of-values recursion, and `below` can be viewed as a dictionary
  of the "previous values".
  We search this dictionary using the auxiliary function `toBelowAux`.
  The dictionary is built using the `PProd` (`And` for inductive predicates).
  We keep searching it until we find `C recArg`, where `C` is the auxiliary fresh variable created at `withBelowDict`.  -/
private partial def toBelow (below : Expr) (numIndParams : Nat) (recArg : Expr) : MetaM Expr := do
  withBelowDict below numIndParams fun C belowDict =>
    toBelowAux C belowDict recArg below

/--
  Return true iff `e` contains an application `recFnName .. t ..` where the term `t` is
  the argument we are trying to recurse on, and it contains loose bound variables.

  We use this test to decide whether we should process a matcher-application as a regular
  applicaton or not. That is, whether we should push the `below` argument should be affected by the matcher or not.
  If `e` does not contain an application of the form `recFnName .. t ..`, then we know
  the recursion doesn't depend on any pattern variable in this matcher.
-/
private def recArgHasLooseBVarsAt (recFnName : Name) (recArgInfo : RecArgInfo) (e : Expr) : Bool :=
  let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
  let app?   := e.find? fun e =>
     e.isAppOf recFnName && e.getAppNumArgs > recArgPos && (e.getArg! recArgPos).hasLooseBVars
  app?.isSome

private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
  let rec loop (below : Expr) (e : Expr) : M Expr := do
    match e with
    | Expr.lam n d b c =>
      withLocalDecl n c.binderInfo (← loop below d) fun x => do
        mkLambdaFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.forallE n d b c =>
      withLocalDecl n c.binderInfo (← loop below d) fun x => do
        mkForallFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.letE n type val body _ =>
      withLetDecl n (← loop below type) (← loop below val) fun x => do
        mkLetFVars #[x] (← loop below (body.instantiate1 x))
    | Expr.mdata d e _   => return mkMData d (← loop below e)
    | Expr.proj n i e _  => return mkProj n i (← loop below e)
    | Expr.app _ _ _ =>
      let processApp (e : Expr) : M Expr :=
        e.withApp fun f args => do
          if f.isConstOf recFnName then
            let numFixed  := recArgInfo.fixedParams.size
            let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
            if recArgPos >= args.size then
              throwError "insufficient number of parameters at recursive application {indentExpr e}"
            let recArg := args[recArgPos]
            -- For reflexive type, we may have nested recursive applications in recArg
            let recArg ← loop below recArg
            let f ← try toBelow below recArgInfo.indParams.size recArg catch  _ => throwError "failed to eliminate recursive application{indentExpr e}"
            -- Recall that the fixed parameters are not in the scope of the `brecOn`. So, we skip them.
            let argsNonFixed := args.extract numFixed args.size
            -- The function `f` does not explicitly take `recArg` and its indices as arguments. So, we skip them too.
            let mut fArgs := #[]
            for i in [:argsNonFixed.size] do
              if recArgInfo.pos != i && !recArgInfo.indicesPos.contains i then
                let arg := argsNonFixed[i]
                let arg ← replaceRecApps recFnName recArgInfo below arg
                fArgs := fArgs.push arg
            return mkAppN f fArgs
          else
            return mkAppN (← loop below f) (← args.mapM (loop below))
      let matcherApp? ← matchMatcherApp? e
      match matcherApp? with
      | some matcherApp =>
        if !recArgHasLooseBVarsAt recFnName recArgInfo e then
          processApp e
        else
          /- Here is an example we currently not handle
             ```
             def g (xs : List Nat) : Nat :=
             match xs with
             | [] => 0
             | y::ys =>
               match ys with
               | []       => 1
               | _::_::zs => g zs + 1
               | zs       => g ys + 2
             ```
             We are matching on `ys`, but still using `ys` in the third alternative.
             If we push the `below` argument over the dependent match it will be able to eliminate recursive call using `zs`.
             To make it work, users have to write the third alternative as `| zs => g zs + 2`
             If this is too annoying in practice, we may replace `ys` with the matching term, but
             this may generate weird error messages, when it doesn't work. -/
          trace[Elab.definition.structural] "below before matcherApp.addArg: {below} : {← inferType below}"
          let matcherApp ← mapError (matcherApp.addArg below) (fun msg => "failed to add `below` argument to 'matcher' application" ++ indentD msg)
          modify fun s => { s with matcherBelowDep := s.matcherBelowDep.insert matcherApp.matcherName }
          let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
            lambdaTelescope alt fun xs altBody => do
              trace[Elab.definition.structural] "altNumParams: {numParams}, xs: {xs}"
              unless xs.size >= numParams do
                throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
              let belowForAlt := xs[numParams - 1]
              mkLambdaFVars xs (← loop belowForAlt altBody)
          pure { matcherApp with alts := altsNew }.toExpr
      | none => processApp e
    | e => ensureNoRecFn recFnName e
  loop below e

private def mkBRecOn (recFnName : Name) (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
  let type  := (← inferType value).headBeta
  let major := recArgInfo.ys[recArgInfo.pos]
  let otherArgs := recArgInfo.ys.filter fun y => y != major && !recArgInfo.indIndices.contains y
  trace[Elab.definition.structural] "fixedParams: {recArgInfo.fixedParams}, otherArgs: {otherArgs}"
  let motive ← mkForallFVars otherArgs type
  let mut brecOnUniv ← getLevel motive
  trace[Elab.definition.structural] "brecOn univ: {brecOnUniv}"
  let useBInductionOn := recArgInfo.reflexive && brecOnUniv == levelZero
  if recArgInfo.reflexive && brecOnUniv != levelZero then
    brecOnUniv ← decLevel brecOnUniv
  let motive ← mkLambdaFVars (recArgInfo.indIndices.push major) motive
  trace[Elab.definition.structural] "brecOn motive: {motive}"
  let brecOn :=
    if useBInductionOn then
      Lean.mkConst (mkBInductionOnName recArgInfo.indName) recArgInfo.indLevels
    else
      Lean.mkConst (mkBRecOnName recArgInfo.indName) (brecOnUniv :: recArgInfo.indLevels)
  let brecOn := mkAppN brecOn recArgInfo.indParams
  let brecOn := mkApp brecOn motive
  let brecOn := mkAppN brecOn recArgInfo.indIndices
  let brecOn := mkApp brecOn major
  check brecOn
  let brecOnType ← inferType brecOn
  trace[Elab.definition.structural] "brecOn     {brecOn}"
  trace[Elab.definition.structural] "brecOnType {brecOnType}"
  forallBoundedTelescope brecOnType (some 1) fun F _ => do
    let F := F[0]
    let FType ← inferType F
    trace[Elab.definition.structural] "FType: {FType}"
    let FType ← instantiateForall FType recArgInfo.indIndices
    let FType ← instantiateForall FType #[major]
    forallBoundedTelescope FType (some 1) fun below _ => do
      let below := below[0]
      let valueNew     ← replaceRecApps recFnName recArgInfo below value
      let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
      let brecOn       := mkApp brecOn Farg
      pure $ mkAppN brecOn otherArgs

private def shouldBetaReduce (e : Expr) (recFnName : Name) : Bool :=
  if e.isHeadBetaTarget then
    e.getAppFn.find? (·.isConstOf recFnName) |>.isSome
  else
    false

/--
  Beta reduce terms where the recursive function occurs in the lambda term.
  This is useful to improve the effectiveness of `elimRecursion`.
  Example:
  ```
  def f : Nat → Nat
    | 0 => 1
    | i+1 => (fun x => f x) i
  ```
-/
private def preprocess (e : Expr) (recFnName : Name) : CoreM Expr :=
  Core.transform e
   fun e => return TransformStep.visit <|
     if shouldBetaReduce e recFnName then
       e.headBeta
     else
       e

private def elimRecursion (preDef : PreDefinition) : M PreDefinition :=
  withoutModifyingEnv do lambdaTelescope preDef.value fun xs value => do
    addAsAxiom preDef
    let value ← preprocess value preDef.declName
    trace[Elab.definition.structural] "{preDef.declName} {xs} :=\n{value}"
    let numFixed ← getFixedPrefix preDef.declName xs value
    trace[Elab.definition.structural] "numFixed: {numFixed}"
    findRecArg numFixed xs fun recArgInfo => do
      -- when (recArgInfo.indName == `Nat) throwStructuralFailed -- HACK to skip Nat argument
      let valueNew ← mkBRecOn preDef.declName recArgInfo value
      let valueNew ← mkLambdaFVars xs valueNew
      trace[Elab.definition.structural] "result: {valueNew}"
      -- Recursive applications may still occur in expressions that were not visited by replaceRecApps (e.g., in types)
      let valueNew ← ensureNoRecFn preDef.declName valueNew
      pure { preDef with value := valueNew }

partial def addSmartUnfoldingDefAux (preDef : PreDefinition) (matcherBelowDep : NameSet) : MetaM PreDefinition := do
  let recFnName := preDef.declName
  let isMarkedMatcherName (n : Name) : Bool    := matcherBelowDep.contains n
  let isMarkedMatcherConst (e : Expr) : Bool   := e.isConst && isMarkedMatcherName e.constName!
  let isMarkedMatcherApp (e : Expr) : Bool     := isMarkedMatcherConst e.getAppFn
  let containsMarkedMatcher (e : Expr) : Bool := e.find? isMarkedMatcherConst |>.isSome
  let rec visit (e : Expr) : MetaM Expr := do
    match e with
    | Expr.lam ..     => lambdaTelescope e fun xs b => do mkLambdaFVars xs (← visit b)
    | Expr.forallE .. => forallTelescope e fun xs b => do mkForallFVars xs (← visit b)
    | Expr.letE n type val body _ =>
      withLetDecl n type (← visit val) fun x => do
        mkLetFVars #[x] (← visit (body.instantiate1 x))
    | Expr.mdata d b _   => return mkMData d (← visit b)
    | Expr.proj n i s _  => return mkProj n i (← visit s)
    | Expr.app .. =>
      let processApp (e : Expr) : MetaM Expr :=
        e.withApp fun f args => do
          return mkAppN (← visit f) (← args.mapM visit)
      match isMarkedMatcherApp e, (← matchMatcherApp? e) with
      | true, some matcherApp =>
        let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
          lambdaTelescope alt fun xs altBody => do
            unless xs.size >= numParams do
              throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
            if containsMarkedMatcher altBody then
              -- continue
              mkLambdaFVars xs (← visit altBody)
            else
              -- add idRhs marker
              let altBody ← mkLambdaFVars xs[numParams:xs.size] altBody
              let altBody ← mkIdRhs altBody
              mkLambdaFVars xs[0:numParams] altBody
        pure { matcherApp with alts := altsNew }.toExpr
      | _, _ => processApp e
    | _ => pure e
  return { preDef with
    declName  := mkSmartUnfoldingNameFor preDef.declName,
    value     := (← visit preDef.value),
    modifiers := {}
  }

partial def addSmartUnfoldingDef (preDef : PreDefinition) (state : State) : TermElabM Unit := do
  if (← isProp preDef.type) then
    return ()
  else
    let preDefSUnfold ← addSmartUnfoldingDefAux preDef state.matcherBelowDep
    addNonRec preDefSUnfold

def structuralRecursion (preDefs : Array PreDefinition) : TermElabM Unit :=
  if preDefs.size != 1 then
    throwError "structural recursion does not handle mutually recursive functions"
  else do
    let (preDefNonRec, state) ← run $ elimRecursion preDefs[0]
    mapError (addNonRec preDefNonRec) (fun msg => m!"structural recursion failed, produced type incorrect term{indentD msg}")
    addAndCompilePartialRec preDefs
    addSmartUnfoldingDef preDefs[0] state

builtin_initialize
  registerTraceClass `Elab.definition.structural

end Structural

export Structural (structuralRecursion)

end Lean.Elab


namespace Papyrus

/--
  A valid (non-zero power of two) alignment.

  LLVM alignments are in terms of bytes (i.e. an alignment of 1 is byte-aligned).
-/
structure Align where
  shiftVal : UInt8
  h : shiftVal < 64
  deriving Repr

-- TODO: Add way to compute `Align` from a raw alignment.
namespace Align

def val (self : Align) : UInt64 :=
  (1 : UInt64) <<< self.shiftVal.toUInt64

partial def ofValAux (i : UInt8) (n : UInt64) : UInt8 :=
  if n < 2 then i else ofValAux (i + 1) (n / 2)

def ofVal (n : UInt64) : Align :=
  mk (ofValAux 0 n % (64 : Nat)) <| Fin.modn_lt _ (Nat.zero_lt_succ _)

-- ## OfNat Instances

section
open Lean

local macro "gen_ofNat_instances" : command => do
  let mut instances := Array.mkEmpty 64
  for i in [0:64] do
    let shiftVal := quote i
    let val := quote <| 1 <<< i
    instances := instances.push <| ←
      `(instance : OfNat Align (nat_lit $val) := ⟨⟨$shiftVal, by decide⟩⟩)
  mkNullNode instances

gen_ofNat_instances
end

/-- The default is byte-aligned. -/
def default : Align := 1

instance : Inhabited Align := ⟨Align.default⟩

-- ## Propositional Relations

theorem eq_of_shiftVal_eq : {a b : Align} → a.shiftVal = b.shiftVal → a = b
  | ⟨v, h⟩, ⟨_, _⟩, rfl => rfl

theorem shiftVal_eq_of_eq {a b : Align} (h : a = b) : a.shiftVal = b.shiftVal :=
  h ▸ rfl

theorem ne_of_shiftVal_ne {a b : Align} (h : a.shiftVal ≠ b.shiftVal) : a ≠ b :=
  fun h' => absurd (shiftVal_eq_of_eq h') h

instance decEq : DecidableEq Align :=
  fun a b =>
    if h : a.shiftVal = b.shiftVal
    then isTrue (eq_of_shiftVal_eq h)
    else isFalse (ne_of_shiftVal_ne h)

instance : LT Align := ⟨fun a b => a.shiftVal < b.shiftVal⟩
instance : LE Align := ⟨fun a b => a.shiftVal <= b.shiftVal⟩

instance decLt (a b : Align) : Decidable (a < b)  := UInt8.decLt ..
instance decLe (a b : Align) : Decidable (a <= b) := UInt8.decLe ..


import Ledger.Costing

namespace Ledger.Costing.Test

-- | Compare to output of `cardano-cli` during Epoch 330.
example : minimumAda default false {numPolicies :=  0, numAssets :=   0, sumAssetNameLengths :=        0} =   999978 := rfl
example : minimumAda default false {numPolicies :=  1, numAssets :=   1, sumAssetNameLengths :=        1} =  1344798 := rfl
example : minimumAda default false {numPolicies :=  1, numAssets :=   1, sumAssetNameLengths :=       32} =  1448244 := rfl
example : minimumAda default false {numPolicies :=  1, numAssets := 110, sumAssetNameLengths := 110 * 32} = 22137444 := rfl
example : minimumAda default false {numPolicies := 60, numAssets :=  60, sumAssetNameLengths :=  60 * 32} = 19758186 := rfl
example : minimumAda default true  {numPolicies :=  0, numAssets :=   0, sumAssetNameLengths :=        0} =  1344798 := rfl
example : minimumAda default true  {numPolicies :=  1, numAssets :=   1, sumAssetNameLengths :=        1} =  1689618 := rfl
example : minimumAda default true  {numPolicies :=  2, numAssets :=   2, sumAssetNameLengths :=        4} =  1862028 := rfl

example : feeForBytes default    0 = 155381         := rfl
example : feeForBytes default 1000 = 155381 + 44000 := rfl

end Ledger.Costing.Test


-- Copyright (c) Microsoft Corporation. All rights reserved.
-- Licensed under the MIT license.

import ..smtexpr
import ..smtcompile
import ..bitvector
import .spec
import .lemmas
import .irstate
import .freevar
import .equiv
import smt2.syntax
import system.io
import init.meta.tactic
import init.meta.interactive

namespace spec

open irsem
open freevar

meta def solve_left :=
  `[ unfold freevar.env.replace_sbv,
     split, refl]

lemma foldr_and_replace: ∀ {α:Type} {f:α → poisonty_smt} p0 (l:list α) (η:freevar.env),
  η⟦list.foldr (λ itm (p:poisonty_smt), p & (f itm)) p0 l⟧ =
    list.foldr (λ itm (p:poisonty_smt), p & η⟦(f itm)⟧) (η⟦p0⟧) l
:= begin
  intros,
  induction l,
  { simp },
  {
    simp,
    rw env.replace_sb_and,
    rw ← l_ih
  }
end

lemma bop_poison_replace: ∀ sz bopc (v1 v2:sbitvec sz) (η:freevar.env),
  η⟦bop_poison irsem_smt sz bopc v1 v2⟧ =
    bop_poison irsem_smt sz bopc (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros,
  cases bopc,
  any_goals { unfold bop_poison,
    delta bop_poison._match_1, delta id_rhs,
    simp, rw env.replace_b2p, refl
  },
  any_goals { -- shl
    unfold bop_poison,
    delta bop_poison._match_1, delta id_rhs,
    simp, rw env.replace_b2p,
    try { unfold has_ult.ult, unfold has_comp.ult },
    try { unfold has_sgt.sgt, unfold has_comp.sgt },
    try { unfold has_ugt.ugt, unfold has_comp.ugt },
    unfold freevar.env.replace_sb,
    congr, unfold uint_like.from_z, rw env.replace_sbv_of_int
  }
end

lemma bop_poison_flag_replace: ∀ sz bopc (v1 v2:sbitvec sz) (η:freevar.env) flag,
  η⟦bop_poison_flag irsem_smt sz bopc flag v1 v2⟧ =
  bop_poison_flag irsem_smt sz bopc flag (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros,
  cases flag,
  any_goals { -- nsw, nuw
    unfold bop_poison_flag,
    cases bopc; unfold bop_overflow_check; rw env.replace_sb_not;
      rw env.replace_b2p,
    { unfold has_overflow_check.add_chk,
      rw env.replace_sb_overflowchk_add },
    { unfold has_overflow_check.sub_chk,
      rw env.replace_sb_overflowchk_sub },
    any_goals {
      unfold has_overflow_check.mul_chk,
      rw env.replace_sb_overflowchk_mul },
    { unfold has_overflow_check.shl_chk,
      rw env.replace_sb_overflowchk_shl }
  },
  { -- exact
    have HZERO: η⟦uint_like.zero sz⟧ = uint_like.zero sz,
    { unfold uint_like.zero, unfold sbitvec.zero, rw env.replace_sbv_of_int },
    unfold bop_poison_flag,
    cases bopc; unfold bop_exact_check; rw env.replace_sb_not; simp,
    any_goals {
      unfold bop_exact_check._match_1,
      rw env.replace_eq2p
    },
    any_goals {
      unfold has_umod.umod, unfold uint_like.urem,
      rw env.replace_sbv_urem, rw HZERO
    },
    any_goals {
      unfold has_mod.mod, unfold uint_like.srem,
      rw env.replace_sbv_srem, rw HZERO
    },
    any_goals {
      unfold has_shl.shl, unfold uint_like.shl,
      rw env.replace_sbv_shl,
      try { unfold has_lshr.lshr, unfold uint_like.lshr,
            rw env.replace_sbv_lshr },
      try { unfold has_ashr.ashr, unfold uint_like.ashr,
            rw env.replace_sbv_ashr },
      unfold has_umod.umod, unfold uint_like.urem,
      rw env.replace_sbv_urem,
      congr; unfold uint_like.from_z; rw env.replace_sbv_of_int
    }
  }
end

lemma bop_replace: ∀ sz bopc flags η v1 p1 v2 p2 ubres vres pres
    (H:(ubres, vres, pres) = bop irsem_smt sz bopc flags v1 p1 v2 p2),
  bop irsem_smt sz bopc flags (η⟦v1⟧) (η⟦p1⟧) (η⟦v2⟧) (η⟦p2⟧) =
    (η⟦ubres⟧, η⟦vres⟧, η⟦pres⟧)
:= begin
  intros,
  unfold bop at *,
  simp at *,
  injection H with HUB H,
  injection H with HV HPOISON,
  congr,
  {
    rw HUB,
    unfold bop_ub,
    cases bopc,
    any_goals { simp, refl, done }, -- non-divison ops
    any_goals { -- udiv, urem
      simp,
      rw env.replace_sb_and, rw env.replace_sb_and,
      rw env.replace_eq2p', refl,
      unfold uint_like.zero, unfold sbitvec.zero,
      rw env.replace_sbv_of_int
    },
    any_goals {
      simp,
      unfold_coes,
      unfold id,
      rw env.replace_sb_and, rw env.replace_sb_and,
      rw env.replace_sb_or, rw env.replace_sb_and,
      rw env.replace_eq2p',
      rw env.replace_eq2p',
      rw env.replace_eq2p',
      { unfold uint_like.allone, unfold sbitvec.uintmax, rw env.replace_sbv_of_int },
      { unfold uint_like.signonly, unfold sbitvec.intmin, rw env.replace_sbv_of_int },
      { unfold uint_like.zero, unfold sbitvec.zero, rw env.replace_sbv_of_int }
    }
  },
  {
    rw HV,
    cases bopc,
    { unfold bop_val,
      unfold has_add.add, unfold uint_like.add, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_sub.sub, unfold uint_like.sub, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_mul.mul, unfold uint_like.mul, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_udiv.udiv, unfold uint_like.udiv, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_umod.umod, unfold uint_like.urem, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_div.div, unfold uint_like.sdiv, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_mod.mod, unfold uint_like.srem, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_and.and, unfold uint_like.and, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_or.or, unfold uint_like.or, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_xor.xor, unfold uint_like.xor, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_shl.shl, unfold uint_like.shl, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_lshr.lshr, unfold uint_like.lshr, unfold freevar.env.replace_sbv },
    { unfold bop_val,
      unfold has_ashr.ashr, unfold uint_like.ashr, unfold freevar.env.replace_sbv }
  },
  {
    rw HPOISON,
    unfold bop_poison_all,
    rw env.replace_sb_and, rw env.replace_sb_and,
    have AND:∀ (p1 p2 q1 q2:poisonty_smt),
      p1&p2 = q1&q2 ↔ p1 = q1 ∧ p2 = q2,
    {
      intros,
      split,
      {
        unfold has_and.and, unfold bool_like.and,
        intros H,
        injection H, split; assumption
      },
      { intros H, cases H with H1 H2, rw [H1, H2] }
    },
    rw AND, rw AND,
    split,
    {
      rw foldr_and_replace,
      rw bop_poison_replace,
      apply list.foldr_eq; try { refl },
      { intros, rw AND, split, refl,
        rw bop_poison_flag_replace },
    },
    split ; refl
  }
end

lemma replace_to_ival: ∀ {sz:size} (v:intty_smt sz) (p:poisonty_smt) (η:freevar.env),
  η⟦to_ival irsem_smt (v, p)⟧ = to_ival irsem_smt (η⟦v⟧, η⟦p⟧)
:= begin
  intros,
  unfold to_ival,
  unfold freevar.env.replace_valty
end

lemma step_bop_replace: ∀ (ss:irstate_smt) bopc flags
    (vop1 vop2: valty_smt)
    vop1' vop2' (η:freevar.env) lhsn
    (HVOP1:vop1' = η⟦vop1⟧)
    (HVOP2:vop2' = η⟦vop2⟧),
  step_bop irsem_smt vop1' vop2' bopc flags (η⟦ss⟧) lhsn =
    η⟦step_bop irsem_smt vop1 vop2 bopc flags ss lhsn⟧'
:= begin
  intros,
  cases vop1 with sz1 v1 p1,
  cases vop2 with sz2 v2 p2,
  unfold freevar.env.replace_valty at *,
  rw [HVOP1, HVOP2],
  unfold step_bop,
  have HSZ: decidable(sz1 = sz2), apply_instance,
  cases HSZ,
  { -- sz1 ≠ sz2
    rw dif_neg, rw dif_neg, assumption, assumption },
  { -- sz1 = sz2
    rw dif_pos, rw dif_pos,
    have HTY: sbitvec sz2 = irsem_smt.intty sz1,
    { rw HSZ, refl },
    generalize HRES1: bop irsem_smt sz1 bopc flags
        (η⟦v1⟧) (η⟦p1⟧) (cast HTY (η⟦v2⟧)) (η⟦p2⟧) = res1,
    generalize HRES2: (bop irsem_smt sz1 bopc flags
        v1 p1 (cast HTY v2) p2) = res2,
    cases res1 with resub1 resvp1,
    cases resvp1 with resv1 resp1,
    cases res2 with resub2 resvp2,
    cases resvp2 with resv2 resp2,
    unfold step_bop._match_2,
    unfold apply,
    rw replace_updatereg,
    rw replace_updateub,
    rw ← env.replace_sbv_cast at HRES1,
    rw bop_replace at HRES1,
    injection HRES1,
    injection h_2 with h_2 h_3,
    congr,
    rw h_1, rw replace_to_ival, congr, rw h_2, rw h_3,
    rw HRES2, repeat { rw HSZ }
  }
end

lemma icmpop_replace: ∀ sz cond η v1 p1 v2 p2 vres pres
    (H:(vres, pres) = icmpop irsem_smt sz cond v1 p1 v2 p2),
  icmpop irsem_smt sz cond (η⟦v1⟧) (η⟦p1⟧) (η⟦v2⟧) (η⟦p2⟧) = (η⟦vres⟧, η⟦pres⟧)
:= begin
  intros,
  cases cond,
  all_goals {
    unfold icmpop at *,
    simp at *,
    unfold icmpop._match_1 at *,
    injection H,
    rw h_1,
    rw h_2,
    rw env.replace_sb_and,
    unfold_coes,
    rw env.replace_sbv_of_bool,
    unfold_ops
  },
  { rw env.replace_sb_eqbv },
  { rw env.replace_sb_nebv },
  { rw env.replace_sb_ult },
  { rw env.replace_sb_ule },
  { rw env.replace_sb_ult },
  { rw env.replace_sb_ule },
  { rw env.replace_sb_slt },
  { rw env.replace_sb_sle },
  { rw env.replace_sb_slt },
  { rw env.replace_sb_sle }
end

lemma step_icmpop_replace: ∀ (ss:irstate_smt) cond
    (vop1 vop2: valty_smt)
    vop1' vop2' (η:freevar.env) lhsn
    (HVOP1:vop1' = η⟦vop1⟧)
    (HVOP2:vop2' = η⟦vop2⟧),
  step_icmpop irsem_smt vop1' vop2' cond (η⟦ss⟧) lhsn =
    η⟦step_icmpop irsem_smt vop1 vop2 cond ss lhsn⟧'
:= begin
  intros,
  cases vop1 with sz1 v1 p1,
  cases vop2 with sz2 v2 p2,
  unfold freevar.env.replace_valty at *,
  rw [HVOP1, HVOP2],
  unfold step_icmpop,
  have HSZ: decidable(sz1 = sz2), apply_instance,
  cases HSZ,
  { -- sz1 ≠ sz2
    rw dif_neg, rw dif_neg, assumption, assumption },
  { -- sz1 = sz2
    rw dif_pos, rw dif_pos,
    have HTY: sbitvec sz2 = irsem_smt.intty sz1,
    { rw HSZ, refl },
    generalize HRES1: icmpop irsem_smt sz1 cond (η⟦v1⟧) (η⟦p1⟧)
        (cast HTY (η⟦v2⟧)) (η⟦p2⟧) = res1,
    generalize HRES2: (icmpop irsem_smt sz1 cond v1 p1
        (cast HTY v2) p2) = res2,
    cases res1 with resv1 resp1,
    cases res2 with resv2 resp2,
    unfold apply,
    rw replace_updatereg,
    rw ← env.replace_sbv_cast at HRES1,
    rw icmpop_replace at HRES1,
    injection HRES1,
    congr,
    rw replace_to_ival, rw h_1, rw h_2,
    rw HRES2, repeat { rw HSZ }
  }
end

lemma selectop_replace: ∀ sz η vcond pcond v1 p1 v2 p2 vres pres
    (H:(vres, pres) = selectop irsem_smt vcond pcond sz v1 p1 v2 p2),
  selectop irsem_smt (η⟦vcond⟧) (η⟦pcond⟧) sz (η⟦v1⟧) (η⟦p1⟧) (η⟦v2⟧) (η⟦p2⟧)
    = (η⟦vres⟧, η⟦pres⟧)
:= begin
  intros,
  unfold selectop at *,
  simp at *,
  injection H,
  rw [h_1, h_2],
  unfold has_ite.ite,
  unfold has_eq.eq, unfold has_comp.eq,
  congr,
  {
    rw env.replace_sbv_ite,
    rw env.replace_sb_eqbv,
    congr
  },
  {
    rw env.replace_sb_and,
    rw env.replace_sb_ite,
    rw env.replace_sb_eqbv,
    congr
  }
end

lemma step_selectop_replace: ∀ (ss:irstate_smt)
    (vcond vop1 vop2: valty_smt)
    vcond' vop1' vop2' (η:freevar.env) lhsn
    (HVCOND:vcond' = η⟦vcond⟧)
    (HVOP1:vop1' = η⟦vop1⟧)
    (HVOP2:vop2' = η⟦vop2⟧),
  step_selectop irsem_smt vcond' vop1' vop2' (η⟦ss⟧) lhsn =
    η⟦step_selectop irsem_smt vcond vop1 vop2 ss lhsn⟧'
:= begin
  intros,
  cases vcond with szcond vcond pcond,
  cases vop1 with sz1 v1 p1,
  cases vop2 with sz2 v2 p2,
  unfold freevar.env.replace_valty at *,
  rw [HVCOND, HVOP1, HVOP2],
  unfold step_selectop,
  have HSZ: decidable(szcond = size.one), apply_instance,
  cases HSZ,
  { -- szcond != size.one
    rw dif_neg, rw dif_neg, assumption, assumption
  },
  { -- szcond = size.one
    rw dif_pos, rw dif_pos HSZ,
    have HSZ2: decidable(sz1 = sz2), apply_instance,
    cases HSZ2,
    {
      rw dif_neg, rw dif_neg, assumption, assumption
    },
    {
      rw dif_pos, rw dif_pos,
      rw ← env.replace_sbv_cast,
      rw ← env.replace_sbv_cast,
      unfold apply,
      rw replace_updatereg,
      rw selectop_replace,
      { congr },
      { refl },
      any_goals { assumption },
      rw HSZ2
    }
  }
end

lemma castop_replace: ∀ fromsz code op1 op1p tosz η vres pres
    (H:(vres, pres) = castop irsem_smt fromsz code op1 op1p tosz),
  castop irsem_smt fromsz code (η⟦op1⟧) (η⟦op1p⟧) tosz
    = (η⟦vres⟧, η⟦pres⟧)
:= begin
  intros,
  cases code,
  any_goals {
    unfold castop at *,
    have H1: decidable (fromsz.val < tosz.val), apply_instance,
    have H2: decidable (fromsz.val = tosz.val), apply_instance,
    cases H1,
    {
      rw if_neg at *, any_goals { assumption },
      cases H2,
      {
        rw if_neg at *, any_goals { assumption },
        injection H with h_1 h_2, rw h_1, rw h_2,
        congr,
        unfold uint_like.trunc, rw env.replace_sbv_trunc
      },
      {
        rw if_pos at *, any_goals { assumption },
        injection H with h_1 h_2, rw h_1, rw h_2,
        congr, unfold uint_like.zero, unfold sbitvec.zero,
        rw env.replace_sbv_of_int
      }
    },
    {
      rw if_pos at *, any_goals { assumption },
      injection H with h_1 h_2, rw h_1, rw h_2,
      try { unfold uint_like.sext, rw env.replace_sbv_sext },
      try { unfold uint_like.zext, rw env.replace_sbv_zext },
    }
  }
end

lemma step_unaryop_replace: ∀ (ss:irstate_smt)
    (vop:valty_smt) (code:uopcode) (toisz:nat) vop' (η:freevar.env) lhsn
    (HVOP:vop' = η⟦vop⟧),
  step_unaryop irsem_smt vop' code toisz (η⟦ss⟧) lhsn =
    η⟦step_unaryop irsem_smt vop code toisz ss lhsn⟧'
:= begin
  intros,
  cases vop with sz v p,
  unfold freevar.env.replace_valty at *,
  rw HVOP,
  cases code,
  { unfold step_unaryop },
  all_goals { unfold step_unaryop,
    have HSZ: decidable (toisz > 0), apply_instance,
    cases HSZ,
    {
      rw dif_neg, rw dif_neg, assumption, assumption
    },
    {
      rw dif_pos, rw dif_pos,
      simp,
      unfold apply,
      rw replace_updatereg,
      rw castop_replace,
      { congr },
      { simp },
      { assumption }
    }
  }
end

lemma step_replace: ∀ (ss:irstate_smt) (i:instruction)
    (η:freevar.env),
  step irsem_smt (η⟦ss⟧) i = η⟦step irsem_smt ss i⟧'
:= begin
  intros,
  cases i,
  case instruction.binop : retty lhs bopc flags op1 op2 {
    cases lhs,

    unfold step,
    unfold has_bind.bind,
    rw get_value_replace,
    generalize HOP1: η⟦get_value irsem_smt ss op1 retty⟧' = vop1,
    generalize HOP2: η⟦get_value irsem_smt ss op2 retty⟧' = vop2,
    simp at HOP1,
    cases vop1,
    { -- none
      rw apply_none at HOP1, rw HOP1, unfold option.bind
    },
    {
      have HOP1' := apply_some HOP1,
      cases HOP1' with vop1' HOP1',
      rw HOP1',
      rw get_value_replace,
      simp at HOP2,
      cases vop2,
      { -- none
        rw apply_none at HOP2, rw HOP2,
        unfold option.bind,
      },
      {
        have HOP2' := apply_some HOP2,
        cases HOP2' with vop2' HOP2',
        rw HOP2',
        unfold option.bind,
        rw step_bop_replace,
        {
          rw HOP1' at HOP1, unfold apply at HOP1, injection HOP1, rw h_1
        },
        { rw HOP2' at HOP2 }
      }
    }
  },
  case instruction.icmpop : opty lhs cond op1 op2 {
    cases lhs,

    unfold step,
    unfold has_bind.bind,
    rw get_value_replace,
    generalize HOP1: η⟦get_value irsem_smt ss op1 opty⟧' = vop1,
    generalize HOP2: η⟦get_value irsem_smt ss op2 opty⟧' = vop2,
    simp at HOP1,
    cases vop1,
    { -- none
      rw apply_none at HOP1, rw HOP1, unfold option.bind
    },
    {
      have HOP1' := apply_some HOP1,
      cases HOP1' with vop1' HOP1',
      rw HOP1',
      rw get_value_replace,
      simp at HOP2,
      cases vop2,
      { -- none
        rw apply_none at HOP2, rw HOP2,
        unfold option.bind,
      },
      {
        have HOP2' := apply_some HOP2,
        cases HOP2' with vop2' HOP2',
        rw HOP2',
        unfold option.bind,
        rw step_icmpop_replace,
        {
          rw HOP1' at HOP1, unfold apply at HOP1, injection HOP1, rw h_1
        },
        { rw HOP2' at HOP2 }
      }
    }
  },
  case instruction.selectop : lhs condty cond opty op1 op2 {
    cases lhs,

    unfold step,
    unfold has_bind.bind,
    rw get_value_replace,

    generalize HOPCOND: η⟦get_value irsem_smt ss cond condty⟧' = vopcond,
    generalize HOP1: η⟦get_value irsem_smt ss op1 opty⟧' = vop1,
    generalize HOP2: η⟦get_value irsem_smt ss op2 opty⟧' = vop2,
    simp at *,
    cases vopcond,
    { rw apply_none at HOPCOND, rw HOPCOND, unfold option.bind },
    {
      have HOPCOND' := apply_some HOPCOND,
      cases HOPCOND' with vopcond' HOPCOND',
      rw HOPCOND',
      unfold option.bind,
      rw get_value_replace,

      cases vop1,
      { rw apply_none at HOP1, rw HOP1, unfold option.bind },
      {
        have HOP1' := apply_some HOP1,
        cases HOP1' with vop1' HOP1',
        rw HOP1',
        rw get_value_replace,
        unfold option.bind,

        cases vop2,
        { rw apply_none at HOP2, rw HOP2, unfold option.bind },
        {
          have HOP2' := apply_some HOP2,
          cases HOP2' with vop2' HOP2',
          rw HOP2',
          unfold option.bind,
          rw step_selectop_replace,
          { rw HOPCOND' at HOPCOND, unfold apply at HOPCOND, injection HOPCOND,
            rw h_1 },
          { rw HOP1' at HOP1 },
          { rw HOP2' at HOP2 }
        }
      }
    }
  },
  case instruction.unaryop : lhs ucode fromty op toty {
    cases lhs,
    cases toty,
    {
      unfold step,
      unfold has_bind.bind,
      rw get_value_replace,

      generalize HOP: η⟦get_value irsem_smt ss op fromty⟧' = vop,
      simp at *,
      cases vop,
      { unfold option.bind, rw apply_none at HOP, rw HOP, refl },
      {
        have HOP' := apply_some HOP,
        cases HOP' with vop' HOP',
        rw HOP',
        unfold option.bind,
        rw step_unaryop_replace,
        { rw HOP' at HOP, unfold apply at HOP, injection HOP, rw h_1 }
      }
    },
    {
      unfold step
    }
  }
end

theorem step_encode_both: ∀ ss se i oss ose η
    (HENC:encode ss se η)
    (HOSS': oss = step irsem_smt ss i)
    (HOSE': ose = step irsem_exec se i),
  none_or_some oss ose (λ ss' se', encode ss' se' η)
:= begin
  intros,
  have HSTEP : none_or_some (step irsem_smt (η⟦ss⟧) i)
      (step irsem_exec se i) (λ ss' se', irstate_equiv ss' se'),
  {
    apply step_both_prf,
    apply HENC,
    refl, refl
  },
  have HOSS'': η⟦oss⟧' = step irsem_smt (η⟦ss⟧) i, {
    rw step_replace,
    rw HOSS'
  },
  simp at HOSS'',
  rw ← HOSS'' at *,
  rw ← HOSE' at *,
  unfold encode at *,
  cases oss,
  {
    unfold none_or_some at *,
    cases HSTEP,
    { rw apply_none at HSTEP, left, assumption },
    { cases HSTEP with _ HSTEP,
      cases HSTEP with _ HSTEP,
      cases HSTEP with HSTEP _,
      unfold apply at HSTEP,
      cases HSTEP
    }
  },
  {
    unfold none_or_some at *,
    cases HSTEP,
    {
      left, cases HSTEP with HSTEP _,
      cases HSTEP
    },
    {
      unfold apply at HSTEP,
      cases HSTEP with s HSTEP,
      cases HSTEP with e HSTEP,
      cases HSTEP with HSTEP_l HSTEP,
      cases HSTEP with HSTEP_r HSTEP_r2,
      injection HSTEP_l,
      rw ← h_1 at HSTEP_r2,
      right,
      apply exists.intro oss,
      apply exists.intro e,
      split, refl,
      split, assumption,
      assumption
    }
  }
end

theorem bigstep_both_prf: bigstep_both
:= begin
  unfold bigstep_both,
  intros,
  revert ss se oss' ose',
  cases p,
  induction p with i p',
  { -- empty instruction
    intros,
    unfold irsem.bigstep at HOSS' HOSE',
    simp at HOSS' HOSE',
    right,
    apply exists.intro ss,
    apply exists.intro se,
    split, assumption, split, assumption, assumption
  },
  { -- a new instruction at the front
    intros,
    generalize HSS:irsem.step irsem_smt ss i = oss0,
    generalize HSE:irsem.step irsem_exec se i = ose0,
    have HENC0 : none_or_some oss0 ose0 (λ ss0 se0, encode ss0 se0 η),
    {
      apply step_encode_both,
      apply HENC, rw HSS, rw HSE
    },
    cases oss0,
    { -- none, none
      have H: ose0 = none, {
        apply none_or_some_none,
        apply HENC0, refl
      },
      rw H at *,
      rw bigstep_unroll_none_smt at HOSS',
      rw bigstep_unroll_none_exec at HOSE',
      rw HOSS', rw HOSE',
      apply none_or_some_none2; refl,
      rw HSE, rw HSS
    },
    { -- some, some
      have H: (∃ se0', ose0 = some se0'), {
        apply none_or_some_some,
        apply HENC0, refl
      },
      cases H with se0' H,
      rw H at *,
      unfold none_or_some at HENC0,
      cases HENC0,
      {
        cases HENC0, cases HENC0_left
      },
      {
        cases HENC0 with s HENC0,
        cases HENC0 with e HENC0,
        cases HENC0 with _ HENC0,
        cases HENC0 with _ HENC0,
        apply p_ih,
        apply HENC0,
        rw ← bigstep_unroll_some_smt, apply HOSS', rw HSS, rw HENC0_left,
        rw ← bigstep_unroll_some_exec, apply HOSE', rw HSE, rw HENC0_left_1
      }
    }
  }
end

lemma bigstep_replace: ∀ ss p (η:freevar.env),
  η⟦bigstep irsem_smt ss p⟧' = bigstep irsem_smt (η⟦ss⟧) p
:= begin
  intros,
  simp,
  cases p,
  revert ss,
  induction p with i p,
  {
    intros,
    refl
  },
  {
    intros,
    generalize HSS: step irsem_smt ss i = ss',
    generalize HRSS: step irsem_smt (η⟦ss⟧) i = rss',
    cases ss'; cases rss',
    {
      rw bigstep_unroll_none_smt,
      rw bigstep_unroll_none_smt,
      rw HRSS, rw HSS
    },
    any_goals {
      rw step_replace at HRSS,
      rw HSS at HRSS, cases HRSS, done
    },
    {
      rw bigstep_unroll_some_smt,
      rw bigstep_unroll_some_smt,
      apply p_ih,
      have HTMP: η⟦step irsem_smt ss i⟧' = η⟦some ss'⟧',
      {
        rw HSS
      },
      rw ← step_replace at HTMP, rw HRSS at HTMP,
      unfold apply at HTMP, injection HTMP,
      rw h_1 at HRSS,
      apply (eq.symm HRSS),
      rw HSS
    }
  }
end

end spec


import tidy.lib.mllist
import tidy.lib.pretty_print
import tidy.lib.tactic

universes u

open tactic
open mllist

meta def kabstract_no_new_goals (t e : expr) (md : transparency) : tactic expr :=
do gs ← get_goals,
   r ← kabstract t e md,
   ng ← num_goals,
   guard (ng = gs.length),
   return r

meta def kabstracter'
  (pattern : tactic (expr × expr × list expr))
  (lhs_replacer : list expr → tactic expr) :
  expr × list (expr × (list expr)) → tactic (expr × list (expr × (list expr)))
| p := do
  (t, L) ← pure p,
  (e, e_type, mvars) ← pattern,
  t' ← kabstract_no_new_goals t e semireducible,
  -- TODO use the discharger to clear remaining metavariables
  -- trace "kabstract:",
  -- trace t,
  -- trace e,
  -- trace mvars,
  -- mvars.mmap (λ m, infer_type m) >>= trace,
  -- trace t',
  guard t'.has_var,
  w ← mk_meta_var e_type,
  let t'' := t'.instantiate_var w,
  mvars' ← mvars.mmap instantiate_mvars,
  return (t'', (w, mvars') :: L) -- FIXME should there be a prime here??

meta def kabstracter
  (pattern : tactic (expr × expr × list expr))
  (lhs_replacer : list expr → tactic expr) (t : expr) : tactic (mllist tactic (expr × list (expr × list expr))) :=
mllist.fix (kabstracter' pattern lhs_replacer) (t, [])

meta def get_lhs : expr -> bool → list expr -> tactic (expr × expr × list expr)
| (expr.pi n bi d b) symm mvars :=
do v <- mk_meta_var d,
   b' <- whnf $ b.instantiate_var v,
   get_lhs b' symm (v :: mvars)
| `(%%a = %%b) symm mvars :=
  do let (a, b) := if symm then (b, a) else (a, b),
     ty ← infer_type a,
     return (a, ty, mvars)
| _ _ _ := failed

meta def replacer : expr -> bool → list expr -> tactic expr
| (expr.pi n bi d b) symm values := replacer b symm values
| `(%%a = %%b) symm values :=
  do let (a, b) := if symm then (b, a) else (a, b),
     return (a.instantiate_vars values)
| _ _ _ := failed

meta def mvars_to_var (e : expr) : expr :=
e.replace (λ e n, if e.is_meta_var then some (expr.var n) else none)

meta def do_substitutions
  (eq : expr) (symm : bool)
  (t_original : expr)
  (lhs rhs : list expr → tactic expr)
  (t_abstracted : expr)
  (rewrite_mvar : expr × list expr)
  (restore_mvars : list (expr × list expr)) : tactic (expr × tactic expr × list expr) :=
lock_tactic_state $
do -- We first restore all the "other" metavariables to their original values.
  --  trace "do_substitutions",
   restore_mvars.mmap (λ p, do l ← lhs p.2, unify p.1 l),
   t_restored ← instantiate_mvars t_abstracted,

   -- r' is the value of the remaining metavariable, after applying the lemma.
   r' ← rhs rewrite_mvar.2,

   guard (¬ r'.has_meta_var),
   -- We now begin constructing the `eq.rec` proof of equality. In fact, we don't construct it here,
   -- we just construct a tactic that can produce it on demand!
   let proof_tactic : tactic expr := do {
    -- r is the original value of the remaining metavariable
    r ← lhs rewrite_mvar.2,

    -- The lemma itself proves `r = r'`.
    let inner_proof := rewrite_mvar.2.reverse.foldl (λ f x : expr, f x) eq,
    inner_proof ← if symm then mk_eq_symm inner_proof else return inner_proof,
    -- trace "inner_proof:",
    -- trace inner_proof,

    -- Next we compute the motive.
    let t_with_var := mvars_to_var t_restored,
    n ← mk_fresh_name,
    -- trace "--",
    -- trace t_with_var,
    -- trace t_original,
    -- trace "r:",
    -- trace r,
    ty ← infer_type r,
    feq ← mk_const `eq,
    v ← mk_mvar,
    let C := expr.lam n binder_info.default ty (feq v t_original t_with_var),
    -- trace "motive:",
    -- trace C,

    -- ... and prepare the actual proof.
    refl ← mk_eq_refl t_original,
    proof ← to_expr ```(@eq.rec _ %%r %%C %%refl _ %%inner_proof),
    -- trace "proof:",
    -- trace proof,
    infer_type proof, -- this is a sanity check (perhaps we should be doing this earlier?)
    return proof
   },
   -- Finally we finish rewriting the expression
   unify rewrite_mvar.1 r',
   result ← instantiate_mvars t_restored,

   metas : list expr ← rewrite_mvar.2.mfilter (λ m, do r ← is_assigned m <|> return tt, return ¬ r),
   return (result, proof_tactic, metas)

meta def all_rewrites_core (t eq : expr) (symm : bool) : tactic (mllist tactic (expr × tactic expr × list expr)) :=
do ty ← infer_type eq,
  let matcher := get_lhs ty symm [],
  let lhs := replacer ty symm,
  let rhs := replacer ty ¬ symm,
  L ← kabstracter matcher lhs t,
  L.mfilter_map (λ p, do_substitutions eq symm t lhs rhs p.1 p.2.head p.2.tail)

meta structure rewrite_all_cfg extends rewrite_cfg :=
(discharger : tactic unit := skip) -- FIXME this is ignored for now
(simplifier : expr → tactic (expr × expr) := λ e, failed) -- FIXME get rid of this?

meta def all_rewrites_lazy (r : expr × bool) (t : expr) (cfg : rewrite_all_cfg := {}) : tactic (mllist tactic (expr × (tactic expr))) :=
do
   L ← all_rewrites_core t r.1 r.2,
   L.filter_map (λ p, if p.2.2 = [] then some (p.1, p.2.1) else none)

meta def all_rewrites (r : expr × bool) (t : expr) (cfg : rewrite_all_cfg := {}): tactic (list (expr × expr)) :=
do L ← all_rewrites_lazy r t cfg,
   L ← L.mmap (λ p, do r ← p.2, return (p.1, r)),
   L.force


import tactic
import category_theory.functor
import data.W.basic
import category_theory.closed.types
import algebra.category.CommRing.basic
import algebra.category.Module.basic

universes w x u v

open category_theory

variables (𝒞 : Type u) [category.{v} 𝒞]

@[protect_proj] structure struc : Type (max u v (w+1) (x+1)) :=
( F : 𝒞 → Type w )
( F_iso : Π {A B : 𝒞}, (A ≅ B) → F A ≃ F B )
( F_iso_refl : Π {A : 𝒞}, F_iso (iso.refl A) = equiv.refl (F A) )
( F_iso_trans : Π {A B C : 𝒞} (e₁ : A ≅ B) (e₂ : B ≅ C),
    equiv.trans (F_iso e₁) (F_iso e₂) = F_iso (iso.trans e₁ e₂) )
( hom : Π {A B : 𝒞} (f : A ⟶ B) (a : F A) (b : F B), Type x )
( hom_iso : Π {A₁ A₂ B₁ B₂ : 𝒞}
    (f₁ : A₁ ⟶ B₁) (a₁ : F A₁) (b₁ : F B₁)
    (f₂ : A₂ ⟶ B₂) (a₂ : F A₂) (b₂ : F B₂)
    (eA : A₁ ≅ A₂) (eB : B₁ ≅ B₂)
    (hf : f₁ ≫ eB.hom = eA.hom ≫ f₂)
    (ha : a₂ = F_iso eA a₁)
    (hb : b₂ = F_iso eB b₁),
    hom f₁ a₁ b₁ ≃ hom f₂ a₂ b₂ )
( hom_iso_refl : Π {A B : 𝒞}
    (f : A ⟶ B) (a : F A) (b : F B)
    (hf : f ≫ (iso.refl B).hom = (iso.refl A).hom ≫ f)
    (ha : a = F_iso (iso.refl A) a)
    (hb : b = F_iso (iso.refl B) b),
    hom_iso f a b f a b (iso.refl A) (iso.refl B) hf ha hb = equiv.refl (hom f a b) )
( hom_iso_trans : Π {A₁ A₂ A₃ B₁ B₂ B₃ : 𝒞}
    (f₁ : A₁ ⟶ B₁) (a₁ : F A₁) (b₁ : F B₁)
    (f₂ : A₂ ⟶ B₂) (a₂ : F A₂) (b₂ : F B₂)
    (f₃ : A₃ ⟶ B₃) (a₃ : F A₃) (b₃ : F B₃)
    (eA₁₂ : A₁ ≅ A₂) (eB₁₂ : B₁ ≅ B₂)
    (eA₂₃ : A₂ ≅ A₃) (eB₂₃ : B₂ ≅ B₃)
    (hf₁₂ : f₁ ≫ eB₁₂.hom = eA₁₂.hom ≫ f₂)
    (hf₂₃ : f₂ ≫ eB₂₃.hom = eA₂₃.hom ≫ f₃)
    (ha₁₂ : a₂ = F_iso eA₁₂ a₁)
    (ha₂₃ : a₃ = F_iso eA₂₃ a₂)
    (hb₁₂ : b₂ = F_iso eB₁₂ b₁)
    (hb₂₃ : b₃ = F_iso eB₂₃ b₂),
    (hom_iso f₁ a₁ b₁ f₂ a₂ b₂ eA₁₂ eB₁₂ hf₁₂ ha₁₂ hb₁₂).trans
    (hom_iso f₂ a₂ b₂ f₃ a₃ b₃ eA₂₃ eB₂₃ hf₂₃ ha₂₃ hb₂₃) =
    hom_iso f₁ a₁ b₁ f₃ a₃ b₃ (eA₁₂.trans eA₂₃) (eB₁₂.trans eB₂₃)
      (by simp [← hf₁₂, ← hf₂₃, category.assoc])
      (by simp [ha₂₃, ha₁₂, ← F_iso_trans])
      (by simp [hb₂₃, hb₁₂, ← F_iso_trans]) )
( id : Π {A : 𝒞} (a : F A), hom (𝟙 A) a a )
( hom_iso_id : Π {A₁ A₂ : 𝒞}
    (a₁ : F A₁) (a₂ : F A₂)
    (eA : A₁ ≅ A₂)
    (hf : 𝟙 A₁ ≫ eA.hom = eA.hom ≫ 𝟙 A₂)
    (ha : a₂ = F_iso eA a₁),
    hom_iso (𝟙 A₁) a₁ a₁ (𝟙 A₂) a₂ a₂ eA eA hf ha ha (id a₁) = id a₂ )
( comp : Π {A B C : 𝒞} {a : F A} {b : F B} {c : F C}
    {f : A ⟶ B} {g : B ⟶ C} (f' : hom f a b) (g' : hom g b c),
    hom (f ≫ g) a c )
( hom_iso_comp : Π {A₁ A₂ B₁ B₂ C₁ C₂}
    (f₁ : A₁ ⟶ B₁) (g₁ : B₁ ⟶ C₁) (a₁ : F A₁) (b₁ : F B₁) (c₁ : F C₁)
    (f₂ : A₂ ⟶ B₂) (g₂ : B₂ ⟶ C₂) (a₂ : F A₂) (b₂ : F B₂) (c₂ : F C₂)
    (eA : A₁ ≅ A₂) (eB : B₁ ≅ B₂) (eC : C₁ ≅ C₂)
    (hf : f₁ ≫ eB.hom = eA.hom ≫ f₂)
    (hg : g₁ ≫ eC.hom = eB.hom ≫ g₂)
    (hfg : (f₁ ≫ g₁) ≫ eC.hom = eA.hom ≫ (f₂ ≫ g₂))
    (ha : a₂ = F_iso eA a₁)
    (hb : b₂ = F_iso eB b₁)
    (hc : c₂ = F_iso eC c₁)
    (f₁' : hom f₁ a₁ b₁)
    (g₁' : hom g₁ b₁ c₁),
    hom_iso (f₁ ≫ g₁) a₁ c₁ (f₂ ≫ g₂) a₂ c₂ eA eC hfg
       ha hc (comp f₁' g₁') =
      comp (hom_iso f₁ a₁ b₁ f₂ a₂ b₂ eA eB hf ha hb f₁')
        (hom_iso g₁ b₁ c₁ g₂ b₂ c₂ eB eC  hg hb hc g₁') )
( id_comp : Π {A B : 𝒞} {f : A ⟶ B} {a : F A} {b : F B}
    (f' : hom f a b), comp (id a) f' = hom_iso f a b (𝟙 A ≫ f) a b (iso.refl A) (iso.refl B)
      (by simp) (by rw F_iso_refl; refl) (by rw F_iso_refl; refl) f' )
( comp_id : Π {A B : 𝒞} {f : A ⟶ B} {a : F A} {b : F B}
    (f' : hom f a b), comp f' (id b) = hom_iso f a b (f ≫ 𝟙 B) a b (iso.refl A) (iso.refl B)
      (by simp) (by rw F_iso_refl; refl) (by rw F_iso_refl; refl) f' )
( assoc : Π {A B C D : 𝒞} {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D}
    {a : F A} {b : F B} {c : F C} {d : F D}
    (f' : hom f a b) (g' : hom g b c) (h' : hom h c d),
    comp (comp f' g') h' = hom_iso (f ≫ (g ≫ h)) a d ((f ≫ g) ≫ h) a d
      (iso.refl A) (iso.refl D) (by simp) (by rw F_iso_refl; refl) (by rw F_iso_refl; refl)
      (comp f' (comp g' h')) )

namespace struc

instance : has_coe_to_fun (struc 𝒞) (λ _, 𝒞 → Type w) :=
{ coe := struc.F }

variables {𝒞}

-- @[protect_proj] class GS (F : 𝒞 → Type w) :=
-- ( hom : Π {A B : 𝒞} (f : A ⟶ B) (a : F A) (b : F B), Type x )
-- ( id : Π {A : 𝒞} (a b : F A) (h : a = b) (f : A ⟶ A) (hf : f = 𝟙 A), hom f a b )

attribute [simp] struc.id_comp struc.comp_id struc.hom_iso_refl struc.F_iso_refl struc.F_iso_trans
  struc.hom_iso_trans

variables (F : struc 𝒞)

-- lemma assoc_left {A B C D : 𝒞} {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D}
--     {a : F A} {b : F B} {c : F C} {d : F D}
--     (f' : F.hom f a b) (g' : F.hom g b c) (h' : F.hom h c d)
--     (i : A ⟶ C) (k : A ⟶ D)
--     (hi : f ≫ g = i) (hk : i ≫ h = k) :
--     F.comp (F.comp f' g' hi) h' hk = F.comp f'
--       (F.comp g' h' rfl) (by rw [← hk, ← hi, category.assoc]) :=
-- begin
--   substs i k,
--   rw struc.assoc,
-- end

-- lemma comp_eq_cast {A B C : 𝒞} {f : A ⟶ B} {g : B ⟶ C}
--   {a : F A} {b : F B} {c : F C} (f' : F.hom f a b) (g' : F.hom g b c)
--   (i : A ⟶ C) (hi : f ≫ g = i)
--   (j : A ⟶ C) (hj : f ≫ g = j) :
--   F.comp f' g' hi = cast (by substs i j) (F.comp f' g' hj) :=
-- begin
--   substs i j, refl
-- end

-- lemma assoc_left' {A B C D : 𝒞} {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D}
--     {a : F A} {b : F B} {c : F C} {d : F D}
--     (f' : F.hom f a b) (g' : F.hom g b c) (h' : F.hom h c d)
--     (i : A ⟶ C) (k : A ⟶ D)
--     (hi : f ≫ g = i) (hk : i ≫ h = k) :
--     F.comp (F.comp f' g' hi) h' hk = cast (by rw [← hk, ← hi, category.assoc])
--       (F.comp f' (F.comp g' h' rfl) rfl)  :=
-- begin
--   rw struc.assoc_left,
--   substs i k,
--   rw [comp_eq_cast]
-- end

-- lemma id_comp' {A B : 𝒞} {f : A ⟶ B} (g : A ⟶ B) {a : F A} {b : F B}
--   (h : 𝟙 A ≫ f = g) (f' : F.hom f a b) :
--   F.comp (F.id a) f' h = cast (by rw [← h, category.id_comp]) f' :=
-- begin
--   rw [category.id_comp] at h,
--   subst h,
--   simp
-- end

-- lemma comp_id' {A B : 𝒞} {f : A ⟶ B} (g : A ⟶ B) {a : F A} {b : F B}
--   (h : f ≫ 𝟙 B = g) (f' : F.hom f a b) :
--   F.comp f' (F.id b) h = cast (by rw [← h, category.comp_id]) f' :=
-- begin
--   rw [category.comp_id] at h,
--   subst h,
--   simp
-- end

def sigma₂ (F : struc 𝒞) : Type* := sigma F

instance : category_struct (sigma₂ F) :=
{ hom := λ A B, Σ (f : A.1 ⟶ B.1), F.hom f A.2 B.2,
  id := λ A, ⟨𝟙 A.1, F.id A.2⟩,
  comp := λ A B C f g, ⟨f.1 ≫ g.1, F.comp f.2 g.2⟩ }

variable {F}

lemma sigma₂.hom_ext {A B : sigma₂ F} {f g : A ⟶ B}
  (h₁ : f.1 = g.1) (h₂ : F.hom_iso f.1 A.2 B.2 g.1 A.2 B.2
    (iso.refl A.1) (iso.refl B.1) (by simp *) (by simp *) (by simp *) f.2 = g.2) :
  f = g :=
begin
  cases A,
  cases B,
  cases f,
  cases g,
  dsimp at *,
  subst h₁,
  simp at h₂,
  subst h₂
end

def sigma_category : category_struct (sigma F) :=
{ hom := λ A B, Σ (f : A.1 ⟶ B.1), F.hom f A.2 B.2,
  id := λ A, ⟨𝟙 A.1, F.id A.2⟩,
  comp := λ A B C f g, ⟨f.1 ≫ g.1, F.comp f.2 g.2⟩ }

@[simp] lemma comp_fst {A B C : sigma₂ F} (f : A ⟶ B) (g : B ⟶ C) :
  (f ≫ g).fst = f.1 ≫ g.1 := rfl

@[simp] lemma comp_snd {A B C : sigma₂ F} (f : A ⟶ B) (g : B ⟶ C) :
  (f ≫ g).snd = F.comp f.2 g.2 := rfl

@[simp] lemma id_fst {A : sigma₂ F} : sigma.fst (𝟙 A) = 𝟙 A.1 := rfl

@[simp] lemma id_snd {A : sigma₂ F} : sigma.snd (𝟙 A) = F.id A.2 := rfl

section

local attribute [instance] sigma_category

instance sigma.category : category (sigma₂ F) :=
{ id_comp' := λ A B f, begin
      refine sigma₂.hom_ext _ _,
      { simp },
      { simp,
        rw [← equiv.trans_apply],
        erw F.hom_iso_trans,
        simp }
    end,
  comp_id' := λ A B f, begin
      refine sigma₂.hom_ext _ _,
      { simp },
      { simp,
        rw [← equiv.trans_apply],
        erw F.hom_iso_trans,
        simp }
    end,
  assoc' := λ A B C D f g h, begin
      refine sigma₂.hom_ext _ _,
      { simp [category.assoc] },
      { simp [struc.assoc],
        rw ← equiv.trans_apply,
        erw F.hom_iso_trans,
        simp,
        erw [F.hom_iso_refl],
        refl }
    end, }

end

instance (X : 𝒞) : category_struct (F X) :=
{ hom := λ A B, F.hom (𝟙 X) A B,
  id := λ A, F.id A,
  comp := λ A B C f g, F.hom_iso (𝟙 X ≫ 𝟙 X) A C (𝟙 X) A C (iso.refl X) (iso.refl X)
    (by simp) (by simp) (by simp) (F.comp f g) }

lemma id_def {X : 𝒞} (x : F X) : 𝟙 x = F.id x := rfl

lemma comp_def (X : 𝒞) (A B C : F X) (f : A ⟶ B) (g : B ⟶ C) :
  f ≫ g = F.hom_iso (𝟙 X ≫ 𝟙 X) A C (𝟙 X) A C (iso.refl X) (iso.refl X)
    (by simp) (by simp) (by simp) (F.comp f g) := rfl

instance (X : 𝒞) : category (F X) :=
{ id_comp' := λ A B f, begin
      simp [id_def, comp_def],
      rw [← equiv.trans_apply, F.hom_iso_trans],
      simp
    end,
  comp_id' := λ A B f, begin
      simp [id_def, comp_def],
      rw [← equiv.trans_apply, F.hom_iso_trans],
      simp
    end,
  assoc' := λ A B C D f g h,
      begin
        simp only [comp_def, ← F.hom_iso_comp],
        erw F.hom_iso_comp,
      end }

def forget : sigma₂ F ⥤ 𝒞 :=
{ obj := sigma.fst,
  map := λ _ _, sigma.fst }

def thing (X : 𝒞) : F X ⥤ sigma₂ F :=
{ obj := λ A, ⟨X, A⟩,
  map := λ A B f, ⟨𝟙 X, f⟩,
  map_id' := λ A, rfl,
  map_comp' := λ A B C f g, sigma.ext
    (by simp) begin
      simp only [comp_snd],
      rw [struc.comp_eq_cast F f g (𝟙 X ≫ 𝟙 X) rfl (𝟙 X)
        (category.comp_id _)],
      symmetry,
      rw [← cast_eq_iff_heq],
      simp, refl,
      simp,
    end }

open opposite

protected def op (F : struc 𝒞) : struc 𝒞ᵒᵖ :=
{ F := λ A, F.F (unop A),
  hom := λ A B f a b, F.hom f.unop b a,
  id := λ A a, F.id a,
  comp := λ A B C a b c f g f' g' h hH,
    F.comp g' f' (by simp [← hH]),
  id_comp := λ A B f a b f', F.comp_id _,
  comp_id := λ A B f a b f', F.id_comp _,
  assoc := λ A B C D f g h a b c d f' g' h',
    by rw F.assoc_left; refl }

def unop (F : struc 𝒞ᵒᵖ) : struc 𝒞 :=
{ F := λ A, F.F (op A),
  hom := λ A B f a b, F.hom f.op b a,
  id := λ A a, F.id a,
  comp := λ A B C a b c f g f' g' h hH,
     F.comp g' f' (by simp [← hH]),
  id_comp := λ A B f a b f', F.comp_id _,
  comp_id := λ A B f a b f', F.id_comp _,
  assoc := λ A B C D f g h a b c d f' g' h',
    by rw F.assoc_left; refl }

def of_functor (F : 𝒞 ⥤ Type w) : struc 𝒞 :=
{ F := F.obj,
  hom := λ A B f a b, plift (F.map f a = b),
  id := λ A a, ⟨by simp⟩,
  comp := λ A B C a b c f g h₁ h₂ _ h, ⟨by simp [← h, F.map_comp, h₁.down, h₂.down]⟩,
  assoc := λ _ _ _ _ _ _ _ _ _ _ _ h₁ h₂ h₃,
    begin simp [h₁.down, h₂.down, h₃.down] end,
  id_comp := λ _ _ _ _ _ h,
    begin simp [h.down] end,
  comp_id := λ _ _ _ _ _ h,
    begin simp [h.down] end }

def Module₂ : struc Ring :=
{ F := λ R, Module R,
  hom := λ R S f M₁ M₂, M₁ →ₛₗ[f] M₂,
  id := λ R M, linear_map.id,
  comp := λ R S T M₁ M₂ M₃ f g f' g' _ h,
    @linear_map.comp _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ⟨h⟩ g' f',
  id_comp := λ R S f M₁ M₂ f', begin
      cases f', cases f, refl
    end,
  comp_id := λ R S f M₁ M₂ f', begin
      cases f', cases f, refl,
    end,
  assoc := λ R S T U f g h M₁ M₂ M₃ M₄ f' g' h',
    begin
      cases f, cases g, cases h, cases f', cases g', cases h',
      refl
    end }

def pi.struc (F : 𝒞 ⥤ Type) (G : struc (sigma₂ (of_functor F))) : struc 𝒞 :=
{ F := λ X, Π a : F.obj X, G.F ⟨X, a⟩,
  hom := λ X Y f x y, Π (a : F.obj X),
    @struc.hom _ _ G ⟨X, a⟩ ⟨Y, F.map f a⟩ ⟨f, ⟨rfl⟩⟩ (x a) (y (F.map f a)),
  id := λ X x a, by convert (G.id (x a)); simp,
  comp := λ X Y Z x y z f g f' g' h H a,
    by convert struc.comp G (f' a) (g' (F.map f a)) rfl; subst H; simp,
  id_comp := λ X a, begin
    intros,
    ext,
    simp,

  end }

-- Maybe think about W.

end struc