import category_theory.lifting_properties.basic
import category_theory.over

namespace category_theory

open category

variables {C : Type*} [category C] {M : C} {A B X Y : under M}
  {i : A ⟶ B} {p : X ⟶ Y} {f : A ⟶ X} {g : B ⟶ Y}
  (sq : comm_sq f i p g)

namespace comm_sq

def lift_struct.map {D : Type*} [category D] (F : C ⥤ D)
  {A B X Y : C} {i : A ⟶ B} {p : X ⟶ Y} {f : A ⟶ X} {g : B ⟶ Y}
  {sq : comm_sq f i p g} (l : sq.lift_struct) : (F.map_comm_sq sq).lift_struct :=
{ l := F.map l.l,
  fac_left' := by { rw [← F.map_comp, l.fac_left], },
  fac_right' := by { rw [← F.map_comp, l.fac_right], }, }

variable (sq)

def under_forget_equiv_lift_struct :
  sq.lift_struct ≃ ((under.forget M).map_comm_sq sq).lift_struct :=
{ to_fun := lift_struct.map (under.forget M),
  inv_fun := λ l,
  { l := structured_arrow.hom_mk l.l begin
      simp only [functor.id_map],
      have w₁ := f.w,
      have w₂ := i.w,
      dsimp at w₁ w₂,
      rw [id_comp] at w₁ w₂,
      have h := l.fac_left,
      dsimp at h,
      rw [w₂, assoc, h, w₁],
    end,
    fac_left' := by { ext, exact l.fac_left, },
    fac_right' := by { ext, exact l.fac_right, }, },
  left_inv := by tidy,
  right_inv := by tidy, }

lemma under_sq_has_lift_iff :
  sq.has_lift ↔ ((under.forget M).map_comm_sq sq).has_lift :=
by simpa only [comm_sq.has_lift.iff] using nonempty.congr
    (under_forget_equiv_lift_struct sq).to_fun (under_forget_equiv_lift_struct sq).inv_fun

end comm_sq

variables (i p)

instance has_lifting_property_under
  [has_lifting_property ((under.forget M).map i) ((under.forget M).map p)] :
  has_lifting_property i p :=
⟨λ f g sq, by { rw comm_sq.under_sq_has_lift_iff, apply_instance, }⟩

end category_theory


import for_mathlib.algebraic_topology.skeleton.split
import for_mathlib.algebraic_topology.skeleton.misc
import category_theory.limits.mono_coprod

open category_theory category_theory.limits opposite
open_locale simplicial

namespace simplicial_object

namespace splitting

variables {C : Type*} [category C] [has_finite_coproducts C]
  {X : simplicial_object C} (s : splitting X) [mono_coprod C]

lemma sk_succ_comm_sq (d : ℕ) :
  comm_sq (sSet.tensor_map₁ (sSet.boundary_inclusion (d+1)) (s.N (d+1)))
    sorry
    ((sSet.tensor_yoneda_adjunction (d+1) (s.N (d+1)) (s.sk (d+1))).symm
    (s.ι_summand_sk (d+1) (index_set.truncated.id (op [d+1]))))
    (s.sk_inclusion (show d ≤ d+1, by exact nat.le_succ _)) :=
begin
  sorry,
end

end splitting

end simplicial_object


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))) (hA : is_open A) (hA' : is_covering A),
  have h1 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open Cm ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm ↔ ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
    assume (m : ℕ),
    have h1 : ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open Cm ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm ↔ ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
      have h1 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
        assume (x : euclidean_space ℝ (fin n)),
        have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
          have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
            have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
              have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                  have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                    have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                      have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                        have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                          have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                            have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                              have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                                have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                                  have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                                    have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                                      have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space ℝ (fin n)) ⟨m, by auto [nat.lt_succ_self]⟩) ⊆ A, from begin
                                        have h1 : ∃ (U : set (euclidean_space ℝ (fin n))), is_open U ∧ x ∈ U ∧ U ∩ (set.Icc (0 : euclidean_space
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open A,
  assume hA2 : is_cover A,

  have h1 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h2 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h3 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],

  have h4 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h5 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h6 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h7 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h8 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h9 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h10 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h11 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h12 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h13 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h14 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h15 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h16 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h17 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h18 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h19 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h20 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h21 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h22 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h23 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h24 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h25 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h26 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h27 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h28 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h29 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h30 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h31 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h32 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h33 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h34 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h35 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h36 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h37 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h38 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h39 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h40 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h41 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h42 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h43 : ∀ m : ℕ, ∃! x : ℝ, x = m, from by auto [exists_unique.exists, exists_unique.unique],
  have h44 : ∀ m : ℕ, ∃! x :
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)),
  assume hA : is_open A,
  assume hA2 : is_covering A,
  have h1 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [set.image_inter_open, set.inter_open_left, set.inter_open_right, set.Icc_is_open],
  have h2 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [set.image_inter_covering, set.inter_covering_left, set.inter_covering_right, set.Icc_is_covering],
  have h3 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h1],
  have h4 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h2],
  have h5 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h3],
  have h6 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h4],
  have h7 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h5],
  have h8 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h6],
  have h9 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h7],
  have h10 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h8],
  have h11 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h9],
  have h12 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h10],
  have h13 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h11],
  have h14 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h12],
  have h15 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h13],
  have h16 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h14],
  have h17 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h15],
  have h18 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h16],
  have h19 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h17],
  have h20 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h18],
  have h21 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h19],
  have h22 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h20],
  have h23 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h21],
  have h24 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h22],
  have h25 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h23],
  have h26 : ∀ (m : ℕ), is_covering (set.image (λ (x : euclidean_space ℝ (fin n)), x ∩ (set.Icc (0 : ℝ) (m : ℝ))) A), from by auto [h24],
  have h27 : ∀ (m : ℕ), is_open (set.image (λ (x : euclidean
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 by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
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 auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
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) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

The writer monad transformer for passing immutable state.
-/
import control.monad.basic
import algebra.group.basic

universes u v w u₀ u₁ v₀ v₁

structure writer_t (ω : Type u) (m : Type u → Type v) (α : Type u) : Type (max u v) :=
(run : m (α × ω))

@[reducible] def writer (ω : Type u) := writer_t ω id

attribute [pp_using_anonymous_constructor] writer_t

namespace writer_t
section
  variable  {ω : Type u}
  variable  {m : Type u → Type v}
  variable  [monad m]
  variables {α β : Type u}
  open function

  @[ext]
  protected

  @[inline] protected def tell (w : ω) : writer_t ω m punit :=
  ⟨pure (punit.star, w)⟩

  @[inline] protected def listen : writer_t ω m α → writer_t ω m (α × ω)
  | ⟨ cmd ⟩ := ⟨ (λ x : α × ω, ((x.1,x.2),x.2)) <$> cmd ⟩

  @[inline] protected def pass : writer_t ω m (α × (ω → ω)) → writer_t ω m α
  | ⟨ cmd ⟩ := ⟨ uncurry (uncurry $ λ x (f : ω → ω) w, (x,f w)) <$> cmd ⟩

  @[inline] protected def pure [has_one ω] (a : α) : writer_t ω m α :=
  ⟨ pure (a,1) ⟩

  @[inline] protected def bind [has_mul ω] (x : writer_t ω m α) (f : α → writer_t ω m β) :
    writer_t ω m β :=
  ⟨ do x  ← x.run,
       x' ← (f x.1).run,
       pure (x'.1,x.2 * x'.2) ⟩

  instance [has_one ω] [has_mul ω] : monad (writer_t ω m) :=
  { pure := λ α, writer_t.pure, bind := λ α β, writer_t.bind }

  instance [monoid ω] [is_lawful_monad m] : is_lawful_monad (writer_t ω m) :=
  { id_map := by { intros, cases x, simp [(<$>),writer_t.bind,writer_t.pure] },
    pure_bind := by { intros, simp [has_pure.pure,writer_t.pure,(>>=),writer_t.bind], ext; refl },
    bind_assoc := by { intros, simp [(>>=),writer_t.bind,mul_assoc] with functor_norm } }

  @[inline] protected def lift [has_one ω] (a : m α) : writer_t ω m α :=
  ⟨ flip prod.mk 1 <$> a ⟩

  instance (m) [monad m] [has_one ω] : has_monad_lift m (writer_t ω m) :=
  ⟨ λ α, writer_t.lift  ⟩

  @[inline] protected def monad_map {m m'} [monad m] [monad m'] {α} (f : Π {α}, m α → m' α) :
    writer_t ω m α → writer_t ω m' α :=
  λ x, ⟨ f x.run ⟩

  instance (m m') [monad m] [monad m'] : monad_functor m m' (writer_t ω m) (writer_t ω m') :=
  ⟨@writer_t.monad_map ω m m' _ _⟩

  @[inline] protected def adapt {ω' : Type u} {α : Type u} (f : ω → ω') :
    writer_t ω m α → writer_t ω' m α :=
  λ x, ⟨prod.map id f <$> x.run⟩

  instance (ε) [has_one ω] [monad m] [monad_except ε m] : monad_except ε (writer_t ω m) :=
  { throw := λ α, writer_t.lift ∘ throw,
    catch := λ α x c, ⟨catch x.run (λ e, (c e).run)⟩ }
end
end writer_t

/--
An implementation of [MonadReader](
https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Reader-Class.html#t:MonadReader).
It does not contain `local` because this function cannot be lifted using `monad_lift`.
Instead, the `monad_reader_adapter` class provides the more general `adapt_reader` function.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader (ρ : out_param (Type u)) (n : Type u → Type u) :=
(lift {α : Type u} : (∀ {m : Type u → Type u} [monad m], reader_t ρ m α) → n α)
```
-/
class monad_writer (ω : out_param (Type u)) (m : Type u → Type v) :=
(tell (w : ω) : m punit)
(listen {α} : m α → m (α × ω))
(pass {α : Type u} : m (α × (ω → ω)) → m α)

export monad_writer

instance {ω : Type u} {m : Type u → Type v} [monad m] : monad_writer ω (writer_t ω m) :=
{ tell := writer_t.tell,
  listen := λ α, writer_t.listen,
  pass := λ α, writer_t.pass }

instance {ω ρ : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (reader_t ρ m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ λ r, listen (cmd r) ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ λ r, pass (cmd r) ⟩ }

def swap_right {α β γ} : (α × β) × γ → (α × γ) × β
| ⟨⟨x,y⟩,z⟩ := ((x,z),y)

instance {ω σ : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (state_t σ m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ λ r, swap_right <$> listen (cmd r) ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ λ r, pass (swap_right <$> cmd r) ⟩ }
open function

def except_t.pass_aux {ε α ω} : except ε (α × (ω → ω)) → except ε α × (ω → ω)
| (except.error a) := (except.error a,id)
| (except.ok (x,y)) := (except.ok x,y)

instance {ω ε : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (except_t ε m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ uncurry (λ x y, flip prod.mk y <$> x) <$> listen cmd ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ pass (except_t.pass_aux <$> cmd) ⟩ }

def option_t.pass_aux {α ω} : option (α × (ω → ω)) → option α × (ω → ω)
| none := (none ,id)
| (some (x,y)) := (some x,y)

instance {ω : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (option_t m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ uncurry (λ x y, flip prod.mk y <$> x) <$> listen cmd ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ pass (option_t.pass_aux <$> cmd) ⟩ }

/-- Adapt a monad stack, changing the type of its top-most environment.

This class is comparable to
[Control.Lens.Magnify](https://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Zoom.html#t:Magnify),
but does not use lenses (why would it), and is derived automatically for any transformer
implementing `monad_functor`.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader_functor (ρ ρ' : out_param (Type u)) (n n' : Type u → Type u) :=
(map {α : Type u} :
  (∀ {m : Type u → Type u} [monad m], reader_t ρ m α → reader_t ρ' m α) → n α → n' α)
```
-/
class monad_writer_adapter (ω ω' : out_param (Type u)) (m m' : Type u → Type v) :=
(adapt_writer {α : Type u} : (ω → ω') → m α → m' α)
export monad_writer_adapter (adapt_writer)

section
variables {ω ω' : Type u} {m m' : Type u → Type v}

/-- Transitivity.

This instance generates the type-class problem with a metavariable argument (which is why this
is marked as `[nolint dangerous_instance]`).
Currently that is not a problem, as there are almost no instances of `monad_functor` or
`monad_writer_adapter`.

see Note [lower instance priority] -/
@[nolint dangerous_instance, priority 100]
instance monad_writer_adapter_trans {n n' : Type u → Type v} [monad_writer_adapter ω ω' m m']
  [monad_functor m m' n n'] : monad_writer_adapter ω ω' n n' :=
⟨λ α f, monad_map (λ α, (adapt_writer f : m α → m' α))⟩

instance [monad m] : monad_writer_adapter ω ω' (writer_t ω m) (writer_t ω' m) :=
⟨λ α, writer_t.adapt⟩
end

instance (ω : Type u) (m out) [monad_run out m] : monad_run (λ α, out (α × ω)) (writer_t ω m) :=
⟨λ α x, run $ x.run ⟩

/-- reduce the equivalence between two writer monads to the equivalence between
their underlying monad -/
def writer_t.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
  {α₁ ω₁ : Type u₀} {α₂ ω₂ : Type u₁} (F : (m₁ (α₁ × ω₁)) ≃ (m₂ (α₂ × ω₂))) :
  writer_t ω₁ m₁ α₁ ≃ writer_t ω₂ m₂ α₂ :=
{ to_fun := λ ⟨f⟩, ⟨F f⟩,
  inv_fun := λ ⟨f⟩, ⟨F.symm f⟩,
  left_inv := λ ⟨f⟩, congr_arg writer_t.mk $ F.left_inv _,
  right_inv := λ ⟨f⟩, congr_arg writer_t.mk $ F.right_inv _ }


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((a2).read i2) ≠ (((a2).write i1 ((a2).read i2)).read i2) → False := by
  arr


import ReactorModel.Objects.Reactor.Updatable

open Classical

namespace Reactor

protected inductive Core
  | mk
    (ports : Kind → ID ⇀ Value)
    (acts :  ID ⇀ Action)
    (state : ID ⇀ Value)
    (rcns :  ID ⇀ Reaction)
    (nest :  ID → Option Reactor.Core)

namespace Core

instance reactorType : ReactorType Reactor.Core where
  ports | mk p _ _ _ _ => p
  acts  | mk _ a _ _ _ => a
  state | mk _ _ s _ _ => s
  rcns  | mk _ _ _ r _ => r
  nest  | mk _ _ _ _ n => n

instance : ReactorType.Extensional Reactor.Core where
  ext_iff := by intro (mk ..) (mk ..); open ReactorType in simp [ports, state, rcns, acts, nest]

instance : ReactorType.WellFounded Reactor.Core where
  wf := by
    constructor
    apply Reactor.Core.rec
      (motive_1 := fun rtr => Acc ReactorType.Nested rtr)
      (motive_2 := fun | none => True | some rtr => Acc ReactorType.Nested rtr)
    all_goals simp
    intro _ _ _ _ _ hi
    constructor
    intro n ⟨i, hn⟩
    simp [ReactorType.nest] at hn
    have := hn ▸ hi i
    simp_all

noncomputable section Update
open ReactorType

abbrev «with»
    (rtr : Reactor.Core) (ports : Kind → ID ⇀ Value := ports rtr) (acts : ID ⇀ Action := acts rtr)
    (state : ID ⇀ Value := state rtr) (rcns : ID ⇀ Reaction := rcns rtr)
    (nest : ID ⇀ Reactor.Core := nest rtr) :=
  Reactor.Core.mk ports acts state rcns nest

def insert [inst : ReactorType Reactor.Core]
    (rtr : Reactor.Core) (cpt : Component) (i : ID) (v : inst.cptType cpt) :=
  match cpt with
  | .prt k => rtr.with (ports := Function.update (ports rtr) k $ ports rtr k |>.insert i v)
  | .act   => rtr.with (acts  := acts  rtr |>.insert i v)
  | .stv   => rtr.with (state := state rtr |>.insert i v)
  | .rcn   => rtr.with (rcns  := rcns  rtr |>.insert i v)
  | .rtr   => rtr.with (nest  := nest  rtr |>.insert i v)

theorem insert_cpt?_eq_self {rtr : Reactor.Core} (cpt) {i v} :
    cpt? cpt (rtr.insert cpt i v) i = v := by
  cases cpt <;> try cases ‹Component.Valued›
  all_goals
    simp [insert, cpt?, reactorType]
    apply Partial.insert_same

theorem insert_cpt?_ne_cpt_or_id {rtr : Reactor.Core} (h : c ≠ cpt ∨ j ≠ i) :
    cpt? c rtr j = cpt? c (rtr.insert cpt i v) j := by
  cases cpt <;> try cases ‹Component.Valued› <;> try cases ‹Kind›
  all_goals cases c <;> try cases ‹Component.Valued› <;> try cases ‹Kind›
  all_goals
    simp [cpt?, insert]
    try simp [reactorType]; done
  all_goals
    cases h
    case inl h => contradiction
    case inr h => exact Partial.insert_ne _ h |>.symm

def updateMem {rtr : Reactor.Core} {cpt : Component.Valued} (f : cpt.type → cpt.type) :
    Member cpt i rtr → Reactor.Core
  | .final h           => rtr.insert cpt i $ f (Partial.mem_iff.mp h).choose
  | .nest (j := j) _ l => rtr.insert .rtr j (updateMem f l)

theorem updateMem_lawfulMemUpdate
    {cpt : Component.Valued} (l : Member cpt i rtr)
    (f : cpt.type → cpt.type) : LawfulMemUpdate cpt i f rtr (updateMem f l) := by
  induction l <;> simp [updateMem]
  case final h =>
    replace h := Partial.mem_iff.mp h
    exact .final insert_cpt?_ne_cpt_or_id h.choose_spec (insert_cpt?_eq_self cpt)
  case nest h l hi =>
    exact .nest insert_cpt?_ne_cpt_or_id h (insert_cpt?_eq_self .rtr) hi

def update (rtr : Reactor.Core) (cpt : Component.Valued) (i : ID) (f : cpt.type → cpt.type) :=
  if l : Nonempty (Member cpt i rtr) then updateMem f l.some else rtr

instance : ReactorType.LawfulUpdatable Reactor.Core where
  update := update
  lawful rtr cpt i f :=
    if h : Nonempty (Member (Component.val cpt) i rtr)
    then .update $ by simp [update, h]; exact updateMem_lawfulMemUpdate h.some f
    else .notMem (not_nonempty_iff.mp h) $ by simp [update, h]

end Update
end Core
end Reactor


import abstraction.concepts
universe u
open set topological_space classical
local attribute [instance] prop_decidable

-- THIS FILE IS A WORK IN PROGRESS
-- TERMINOLOGY HERE DIFFERS FROM THE REST OF THE PROJECT

namespace ontology
  variables (ω : ontology)
  section matter

    -- We call any composite substance `physical`,
    -- or a `body`.

    @[reducible]
    def substance.physical {ω : ontology} (s : ω.substance) := s.composite
    def cosmos_set := {s : ω.substance | s.physical}
    def body := subtype ω.cosmos_set

    -- The cosmos is the integral whole of all
    -- composite (physical) substances.
    def cosmos := integral_whole ω.cosmos_set

    -- Prime matter is the abstract whole of all
    -- composite (physical) substances.
    def prime_matter := abstract_whole ω.cosmos_set

    -- There are specifically two dual notions of `matter` that are obtained
    -- by considering virtual substances (concepts)
    -- as the totalities of both kinds of matter:

    -- (1) From the point of view of the whole,
    -- matter can be thought of as that which
    -- actively composes a thing, its substratum.
    -- This sense we will only cover in the next
    -- section, which is mereology.

    -- (2) From the point of view of matter itself,
    -- matter can be thought of as that which is in potency
    -- to a multiplicty of forms, in the sense of prime matter.
    -- Mathematically these two notions are dual,
    -- with the duality of Π and Σ types, respectively.

    -- Notice, in the first notion matter is actual,
    -- and in the second potential.

    -- Transcendent matter is the abstract whole of all
    -- substances.
    -- This is the virtual substance that is "in potency"
    -- for becoming any other substance.
    def transcendent_matter : ω.concept := abstract_whole univ

    -- The state space of a virtual, likely possible, substance
    -- corresponding to a concrete and immanent notion of matter.
    -- This virtual is the mereological sum of the set of all substances.
    -- It is the whole of reality.
    def reality : ω.concept := integral_whole univ

    -- Of course nothing in reality is an instance of
    -- prime or transcendent matter.

  end matter

  section mereology

    -- A substance s₁ is an integral part of another
    -- substance s₂ if there is a
    -- (necessarilly nonempty) set S of substances
    -- such that the integral whole of {s₁} ∪ S is
    -- homeomorphic to the state space of s₂ by
    -- means of a state-preserving homeomorphism
    def substance.part_of {ω : ontology} (s₁ s₂ : ω.substance) :=
      -- s₁ ≠ s₂ ∧
      ∃ S : set ω.substance,
      S.nonempty ∧
      s₁ ∉ S ∧
      -- (∀ x ∈ S, x ≠ s₂) ∧
      ∃ hom :
          s₂.concept.state ≃ₜ
          (integral_whole $ S ∪ {s₁}).state,
      state_preserving hom.to_fun

    -- This is to say that if we know the state of the
    -- substance s₂ in a possible world w, then we
    -- already know the state of each of its parts,
    -- since there is a functional dependence between them.

    --  @[trans]
    --  lemma part_of_trans : ∀ s₁ s₂ s₃ : ω.substance,
    --                        s₁.part_of s₂ →
    --                        s₂.part_of s₃ →
    --                        s₁.part_of s₃ :=
    --     begin
    --         intros s₁ s₂ s₃ h₁ h₂,
    --         -- simp [substance.part_of] at *,
    --         obtain ⟨S₁, ne₁, notin₁, hom₁, h₁⟩ := h₁,
    --         obtain ⟨S₂, ne₂, notin₂, hom₂, h₂⟩ := h₂,
    --         use S₁ ∪ S₂ ∪ {s₂},
    --         simp,
              -- TODO
    --     end

  end mereology
end ontology


import Std.Data.PersistentHashMap

open Std
def m : PersistentHashMap Nat Nat :=
let m : PersistentHashMap Nat Nat := {};
m.insert 1 1

def natDiffHash : Hashable Nat :=
⟨fun n => UInt64.ofNat $ n+10⟩

-- The following example should fail since the `Hashable` instance used to create `m` is not `natDiffHash`
#eval @PersistentHashMap.find? Nat Nat _ natDiffHash m 1


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a2).write i3 (v1)).write i1 (v1)).read i3) → False := by
  arr


import vc0.basic

namespace c0

open ast ast.gdecl

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

namespace value

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

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

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

end value

namespace addr

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

end addr

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

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

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

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

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

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

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

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

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

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

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

end c0


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((a3).write i1 (v3)) = (a3) → ((a3).read i1) ≠ (v3) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v2) ≠ ((((a3).write i3 (v2)).write i2 (v2)).read i3) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v2) ≠ ((((a3).write i2 (v2)).write i3 (v2)).read i2) → False := by
  arr


import code
import frespects_pfun

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

open boolcodeable (encode decode)

local attribute [reducible] bitstring

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

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

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

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

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

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

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


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((a3).read i2) ≠ (((a3).write i1 ((a3).read i2)).read i2) → False := by
  arr