-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Patrick Massot, Scott Morrison, Mario Carneiro

import category_theory.full_subcategory
import category_theory.functor_category
import category_theory.natural_isomorphism
import analysis.topology.topological_space
import analysis.topology.continuity

open category_theory
open category_theory.nat_iso

universe u

namespace category_theory.examples

/-- The category of topological spaces and continuous maps. -/
@[reducible] def Top : Type (u+1) := bundled topological_space

instance (x : Top) : topological_space x := x.str

namespace Top
instance : concrete_category @continuous := ⟨@continuous_id, @continuous.comp⟩

-- local attribute [class] continuous
-- instance {R S : Top} (f : R ⟶ S) : continuous (f : R → S) := f.2
end Top

structure open_set (X : Top.{u}) : Type u :=
(s : set X.α)
(is_open : topological_space.is_open X.str s)

variables {X : Top.{u}}

namespace open_set
instance : has_coe (open_set X) (set X.α) := { coe := λ U, U.s }

instance : has_subset (open_set X) :=
{ subset := λ U V, U.s ⊆ V.s }

instance : preorder (open_set X) := by refine { le := (⊇), .. } ; tidy

instance open_sets : small_category (open_set X) := by apply_instance

instance : has_mem X.α (open_set X) :=
{ mem := λ a V, a ∈ V.s }

def nbhd (x : X.α) := { U : open_set X // x ∈ U }
def nbhds (x : X.α) : small_category (nbhd x) := begin unfold nbhd, apply_instance end

/-- `open_set.map f` gives the functor from open sets in Y to open set in X,
    given by taking preimages under f. -/
def map
  {X Y : Top.{u}} (f : X ⟶ Y) : open_set Y ⥤ open_set X :=
{ obj := λ U, ⟨ f.val ⁻¹' U.s, f.property _ U.is_open ⟩,
  map' := λ U V i, ⟨ ⟨ λ a b, i.down.down b ⟩ ⟩ }.

@[simp] lemma map_id_obj (X : Top.{u}) (U : open_set X) : map (𝟙 X) U = U :=
begin
  cases U, tidy
end

@[simp] def map_id (X : Top.{u}) : map (𝟙 X) ≅ functor.id (open_set X) :=
{ hom := { app := λ U, 𝟙 U },
  inv := { app := λ U, 𝟙 U } }

-- We could make f g implicit here, but it's nice to be able to see when they are the identity (often!)
def map_iso {X Y : Top.{u}} (f g : X ⟶ Y) (h : f = g) : map f ≅ map g :=
nat_iso.of_components (λ U, eq_to_iso (congr_fun (congr_arg _ (congr_arg _ h)) _) ) (by obviously)

@[simp] def map_iso_id {X : Top.{u}} (h) : map_iso (𝟙 X) (𝟙 X) h = iso.refl (map _) := rfl

end open_set

end category_theory.examples


import LMT

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

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


import Smt

theorem index : "a".get 0 = 'a' := by
  smt
  rfl


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan and Scott Morrison

import category_theory.graphs.category

-- FIXME why do we need this here?
@[obviously] meta def obviously_4 := tactic.tidy { tactics := extended_tidy_tactics }

open category_theory
open category_theory.graphs

universes v₁ v₂ u₁ u₂

namespace category_theory.graphs

def paths (C : Type u₂) := C

instance paths_category (C : Type u₁) [graph.{v₁} C] : category.{(max u₁ v₁)+1} (paths C) :=
{ hom     := λ x y : C, path x y,
  id      := λ x, path.nil x,
  comp    := λ _ _ _ f g, concatenate_paths f g,
  comp_id' := begin
              tidy,
              induction f, -- PROJECT think about how to automate an inductive step. When can you be sure it's a good idea?
              obviously,
             end,
  assoc'  := begin
              tidy,
              induction f,
              obviously,
            end }.

instance paths_small_category (C : Type u₁) [graph.{u₁ u₁} C] : small_category (paths C) := graphs.paths_category C

variables {C : Type u₂} [𝒞 : category.{v₂} C] {G : Type u₁} [𝒢 : graph.{v₁} G]
include 𝒢 𝒞

@[simp] def path_to_morphism
  (H : graph_hom G C)
  : Π {X Y : G}, path X Y → ((H.onVertices X) ⟶ (H.onVertices Y))
| ._ ._ (path.nil Z)              := 𝟙 (H.onVertices Z)
| ._ ._ (@path.cons ._ _ _ _ _ e p) := (H.onEdges e) ≫ (path_to_morphism p)

@[simp] lemma path_to_morphism.comp (H : graph_hom G C) {X Y Z : paths G} (f : X ⟶ Y) (g : Y ⟶ Z) : path_to_morphism H (f ≫ g) = path_to_morphism H f ≫ path_to_morphism H g :=
begin
  induction f,
  obviously,
end

end category_theory.graphs

namespace category_theory.functor

open category_theory.graphs

variables {C : Type u₂} [𝒞 : category.{v₂} C] {G : Type u₁} [𝒢 : graph.{v₁} G]
include 𝒢 𝒞

-- PROJECT obtain this as the left adjoint to the forgetful functor.
@[simp] def of_graph_hom (H : graph_hom G C) : (paths G) ⥤ C :=
{ obj := λ X, (H.onVertices X),
  map := λ _ _ f, (path_to_morphism H f) }

end category_theory.functor


import Duper.MClause
import Duper.RuleM
import Duper.Simp
import Duper.Util.ProofReconstruction

-- LoobHoist          BoolHoist
--             C<u>
-- -----------------------------
-- C<⊤> ∨ u = ⊥     C<⊥> ∨ u = ⊤
--
-- where u is of type Prop, but neither ⊥ nor ⊤, and u is not at the top level of a positive literal.

namespace Duper
open Lean
open RuleM
open Meta
open SimpResult

initialize Lean.registerTraceClass `Rule.identBoolHoist

theorem loob_hoist_proof (f : Prop → Prop) (e : Prop) (H : f e) : f True ∨ e = False :=
  @Classical.byCases e _
    (fun p => have h : e = True := by simp [p];
              Or.inl (h ▸ H))
    (fun np => by simp [np])

theorem bool_hoist_proof (f : Prop → Prop) (e : Prop) (H : f e) : f False ∨ e = True :=
  @Classical.byCases e _
    (fun p => by simp [p])
    (fun np => have h : e = False := by simp [np];
               Or.inl (h ▸ H))

def mkBoolHoistProof (pos : ClausePos) (sgn : Bool) (premises : List Expr)
  (parents : List ProofParent) (transferExprs : Array Expr) (c : Clause) : MetaM Expr :=
  Meta.forallTelescope c.toForallExpr fun xs body => do
    let cLits := c.lits.map (fun l => l.map (fun e => e.instantiateRev xs))
    let (parentsLits, appliedPremises, transferExprs) ← instantiatePremises parents premises xs transferExprs
    let parentLits := parentsLits[0]!
    let appliedPremise := appliedPremises[0]!

    let i := pos.lit
    let ⟨s, p⟩ := pos.toLitPos

    let mut caseProofs := Array.mkEmpty parentLits.size
    for j in [:parentLits.size] do
      let lit := parentLits[j]!
      if j == i then
        let lp : LitPos := ⟨s, p⟩
        let f ← Meta.withLocalDeclD `h (.sort .zero) fun h => do
          let lit' ← lit.replaceAtPos! lp h
          let f := lit'.toExpr
          Meta.mkLambdaFVars #[h] f
        let e ← lit.getAtPos! lp
        let pr ← Meta.withLocalDeclD `h lit.toExpr fun h => do
          let mut pr := h
          if sgn then
            pr ← Meta.mkAppM ``loob_hoist_proof #[f, e, h]
          else
            pr ← Meta.mkAppM ``bool_hoist_proof #[f, e, h]
          Meta.mkLambdaFVars #[h] $ ← orSubclause (cLits.map Lit.toExpr) 2 pr
        caseProofs := caseProofs.push pr
      else
        -- need proof of `L_j → L_1 ∨ ... ∨ L_n`
        let pr ← Meta.withLocalDeclD `h lit.toExpr fun h => do
          let idx := if j ≥ i then j - 1 else j
          Meta.mkLambdaFVars #[h] $ ← orIntro (cLits.map Lit.toExpr) idx h
        caseProofs := caseProofs.push pr

    let r ← orCases (parentLits.map Lit.toExpr) caseProofs
    Meta.mkLambdaFVars xs $ mkApp r appliedPremise

def identBoolHoistAtExpr (e : Expr) (pos : ClausePos) (c : MClause) : RuleM (Option (Array (Clause × Proof))) :=
  withoutModifyingMCtx do
    let ty ← inferType e
    if ty == .sort .zero then
      let l := pos.lit
      let ⟨s, p⟩ := pos.toLitPos
      trace[Rule.identBoolHoist] m!"Inspecting position {pos} in clause {c.lits.map Lit.toExpr}"
      let is_true := e == (mkConst ``True)
      let is_false := e == (mkConst ``False)
      let is_top_positive := p.size == 0 ∧ c.lits[l]!.sign
      if is_true ∨ is_false ∨ is_top_positive then
        return none
      else
        trace[Rule.identBoolHoist] m!"BoolHoist at literal {l}, side {s}, position {p} in clause {c.lits.map Lit.toExpr}"
        let litl := c.lits[l]!
        let c_erased := c.eraseLit l
        let nc := c_erased.appendLits
          #[← litl.replaceAtPos! ⟨s, p⟩ (mkConst ``True), Lit.fromSingleExpr e false]
        trace[Rule.identBoolHoist] s!"New Clause: {nc.lits.map Lit.toExpr}"
        let cp1 ← yieldClause nc "identity loobHoist" (some (mkBoolHoistProof pos true))
        let nc := c_erased.appendLits
          #[← litl.replaceAtPos! ⟨s, p⟩ (mkConst ``False), Lit.fromSingleExpr e true]
        trace[Rule.identBoolHoist] s!"New Clause: {nc.lits.map Lit.toExpr}"
        let cp2 ← yieldClause nc "identity boolHoist" (some (mkBoolHoistProof pos false))
        return some #[cp1, cp2]
    else
      return none

def identBoolHoist : MSimpRule := fun c => do
  let c ← loadClause c
  let fold_fn := fun acc e pos => do
    match acc with
    | some res => return some res
    | none => identBoolHoistAtExpr e pos c
  c.foldGreenM fold_fn none


import for_mathlib.derived_functor
import category_theory.abelian.left_derived

universes w v u

noncomputable theory

namespace category_theory.abelian.functor

open category_theory category_theory.functor category_theory.limits
open category_theory.functor.left_derived

variables {C : Type u} {D : Type u} [category.{w} C] [category.{w} D] [enough_projectives C]
variables (F : C ⥤ D) {A₁ A₂ A₃ X : C} {f : A₁ ⟶ A₂} {g : A₂ ⟶ A₃}
variables [abelian C] [abelian D] [additive F] [preserves_finite_colimits F]

section les

def δ₀ (A : short_exact_sequence C) := δ F 0 A ≫ (left_derived_zero_iso_self F).hom.app A.1

lemma seven_term_exact_seq (A : short_exact_sequence C) :
  exact_seq D [
    (F.left_derived 1).map A.f, (F.left_derived 1).map A.g,
    δ₀ F A,
    F.map A.f, F.map A.g, (0 : F.obj A.3 ⟶ F.obj A.3)] :=
begin
  refine exact_seq.cons _ _ (exact_of_short_exact _ _ _) _ (exact_seq.cons _ _ _ _ _),
  { refine preadditive.exact_of_iso_of_exact' ((F.left_derived 1).map A.g) (δ F 0 A) _ _
      (iso.refl _) (iso.refl _) ((left_derived_zero_iso_self F).app A.1) (by simp) _ _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 1 2) } },
  refine exact_seq.cons _ _ _ _ _,
  { refine preadditive.exact_of_iso_of_exact' (δ F 0 A) ((F.left_derived 0).map A.f) _ _
      (iso.refl _) ((left_derived_zero_iso_self F).app A.1) ((left_derived_zero_iso_self F).app A.2)
      _ (by simp) _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 2 2) } },
    apply exact_seq.cons,
    { exact preserves_exact_of_preserves_finite_colimits_of_epi _ A.exact' },
    { rw [← exact_iff_exact_seq],
      exact ((abelian.tfae_epi (F.obj A.3) (F.map A.g)).out 0 2).1 infer_instance, }
end

end les

end category_theory.abelian.functor


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebraic_geometry.AffineScheme
import ring_theory.nilpotent
import topology.sheaves.sheaf_condition.sites
import category_theory.limits.constructions.binary_products
import algebra.category.CommRing.constructions
import ring_theory.integral_domain
import ring_theory.local_properties

/-!
# Basic properties of schemes

We provide some basic properties of schemes

## Main definition
* `algebraic_geometry.is_integral`: A scheme is integral if it is nontrivial and all nontrivial
  components of the structure sheaf are integral domains.
* `algebraic_geometry.is_reduced`: A scheme is reduced if all the components of the structure sheaf
  is reduced.
-/

open topological_space opposite category_theory category_theory.limits Top

namespace algebraic_geometry

variable (X : Scheme)

instance : t0_space X.carrier :=
begin
  rw t0_space_iff_distinguishable,
  intros x y h h',
  obtain ⟨U, R, ⟨e⟩⟩ := X.local_affine x,
  have hy := (h' _ U.1.2).mp U.2,
  erw ← subtype_indistinguishable_iff (⟨x, U.2⟩ : U.1.1) (⟨y, hy⟩ : U.1.1) at h',
  let e' : U.1 ≃ₜ prime_spectrum R :=
    homeo_of_iso ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _).map_iso e),
  have := t0_space_of_injective_of_continuous e'.injective e'.continuous,
  rw t0_space_iff_distinguishable at this,
  exact this ⟨x, U.2⟩ ⟨y, hy⟩ (by simpa using h) h'
end

instance : quasi_sober X.carrier :=
begin
  apply_with (quasi_sober_of_open_cover
    (set.range (λ x, set.range $ (X.affine_cover.map x).1.base)))
    { instances := ff },
  { rintro ⟨_,i,rfl⟩, exact (X.affine_cover.is_open i).base_open.open_range },
  { rintro ⟨_,i,rfl⟩,
    exact @@open_embedding.quasi_sober _ _ _
      (homeomorph.of_embedding _ (X.affine_cover.is_open i).base_open.to_embedding)
      .symm.open_embedding prime_spectrum.quasi_sober },
  { rw [set.top_eq_univ, set.sUnion_range, set.eq_univ_iff_forall],
    intro x, exact ⟨_, ⟨_, rfl⟩, X.affine_cover.covers x⟩ }
end

/-- A scheme `X` is reduced if all `𝒪ₓ(U)` are reduced. -/
class is_reduced : Prop :=
(component_reduced : ∀ U, _root_.is_reduced (X.presheaf.obj (op U)) . tactic.apply_instance)

attribute [instance] is_reduced.component_reduced

lemma is_reduced_of_stalk_is_reduced [∀ x : X.carrier, _root_.is_reduced (X.presheaf.stalk x)] :
  is_reduced X :=
begin
  refine ⟨λ U, ⟨λ s hs, _⟩⟩,
  apply presheaf.section_ext X.sheaf U s 0,
  intro x,
  rw ring_hom.map_zero,
  change X.presheaf.germ x s = 0,
  exact (hs.map _).eq_zero
end

instance stalk_is_reduced_of_reduced [is_reduced X] (x : X.carrier) :
  _root_.is_reduced (X.presheaf.stalk x) :=
begin
  constructor,
  rintros g ⟨n, e⟩,
  obtain ⟨U, hxU, s, rfl⟩ := X.presheaf.germ_exist x g,
  rw [← map_pow, ← map_zero (X.presheaf.germ ⟨x, hxU⟩)] at e,
  obtain ⟨V, hxV, iU, iV, e'⟩ := X.presheaf.germ_eq x hxU hxU _ 0 e,
  rw [map_pow, map_zero] at e',
  replace e' := (is_nilpotent.mk _ _ e').eq_zero,
  erw ← concrete_category.congr_hom (X.presheaf.germ_res iU ⟨x, hxV⟩) s,
  rw [comp_apply, e', map_zero]
end

lemma is_reduced_of_open_immersion {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f]
  [is_reduced Y] : is_reduced X :=
begin
  constructor,
  intro U,
  have : U = (opens.map f.1.base).obj (H.base_open.is_open_map.functor.obj U),
  { ext1, exact (set.preimage_image_eq _ H.base_open.inj).symm },
  rw this,
  exact is_reduced_of_injective (inv $ f.1.c.app (op $ H.base_open.is_open_map.functor.obj U))
    (as_iso $ f.1.c.app (op $ H.base_open.is_open_map.functor.obj U) : Y.presheaf.obj _ ≅ _).symm
      .CommRing_iso_to_ring_equiv.injective
end

instance {R : CommRing} [H : _root_.is_reduced R] : is_reduced (Scheme.Spec.obj $ op R) :=
begin
  apply_with is_reduced_of_stalk_is_reduced { instances := ff },
  intro x, dsimp,
  haveI : _root_.is_reduced (CommRing.of $ localization.at_prime (prime_spectrum.as_ideal x)),
  { dsimp, apply_instance },
  exact is_reduced_of_injective (structure_sheaf.stalk_iso R x).hom
    (structure_sheaf.stalk_iso R x).CommRing_iso_to_ring_equiv.injective,
end

lemma affine_is_reduced_iff (R : CommRing) :
  is_reduced (Scheme.Spec.obj $ op R) ↔ _root_.is_reduced R :=
begin
  refine ⟨_, λ h, by exactI infer_instance⟩,
  intro h,
  resetI,
  haveI : _root_.is_reduced (LocallyRingedSpace.Γ.obj (op $ Spec.to_LocallyRingedSpace.obj $ op R)),
  { change _root_.is_reduced ((Scheme.Spec.obj $ op R).presheaf.obj $ op ⊤), apply_instance },
  exact is_reduced_of_injective (to_Spec_Γ R)
    ((as_iso $ to_Spec_Γ R).CommRing_iso_to_ring_equiv.injective)
end

lemma is_reduced_of_is_affine_is_reduced [is_affine X]
  [h : _root_.is_reduced (X.presheaf.obj (op ⊤))] : is_reduced X :=
begin
  haveI : is_reduced (Scheme.Spec.obj (op (Scheme.Γ.obj (op X)))),
  { rw affine_is_reduced_iff, exact h },
  exact is_reduced_of_open_immersion X.iso_Spec.hom,
end

/-- To show that a statement `P` holds for all open subsets of all schemes, it suffices to show that
1. In any scheme `X`, if `P` holds for an open cover of `U`, then `P` holds for `U`.
2. For an open immerison `f : X ⟶ Y`, if `P` holds for the entire space of `X`, then `P` holds for
  the image of `f`.
3. `P` holds for the entire space of an affine scheme.
-/
lemma reduce_to_affine_global (P : ∀ (X : Scheme) (U : opens X.carrier), Prop)
  (h₁ : ∀ (X : Scheme) (U : opens X.carrier),
    (∀ (x : U), ∃ {V} (h : x.1 ∈ V) (i : V ⟶ U), P X V) → P X U)
  (h₂ : ∀ {X Y} (f : X ⟶ Y) [hf : is_open_immersion f], ∃ {U : set X.carrier} {V : set Y.carrier}
    (hU : U = ⊤) (hV : V = set.range f.1.base), P X ⟨U, hU.symm ▸ is_open_univ⟩ →
      P Y ⟨V, hV.symm ▸ hf.base_open.open_range⟩)
  (h₃ : ∀ (R : CommRing), P (Scheme.Spec.obj $ op R) ⊤) :
  ∀ (X : Scheme) (U : opens X.carrier), P X U :=
begin
  intros X U,
  apply h₁,
  intro x,
  obtain ⟨_,⟨j,rfl⟩,hx,i⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open x.prop U.2,
  let U' : opens _ := ⟨_, (X.affine_basis_cover.is_open j).base_open.open_range⟩,
  let i' : U' ⟶ U :=
    hom_of_le i,
  refine ⟨U', hx, i', _⟩,
  obtain ⟨_,_,rfl,rfl,h₂'⟩ := h₂ (X.affine_basis_cover.map j),
  apply h₂',
  apply h₃
end
.

lemma eq_zero_of_basic_open_empty {X : Scheme} [hX : is_reduced X] {U : opens X.carrier}
  (s : X.presheaf.obj (op U)) (hs : X.basic_open s = ∅) :
  s = 0 :=
begin
  apply Top.presheaf.section_ext X.sheaf U,
  simp_rw ring_hom.map_zero,
  unfreezingI { revert X U hX s },
  refine reduce_to_affine_global _ _ _ _,
  { intros X U hx hX s hs x,
    obtain ⟨V, hx, i, H⟩ := hx x,
    unfreezingI { specialize H (X.presheaf.map i.op s) },
    erw Scheme.basic_open_res at H,
    rw [hs, ← subtype.coe_injective.eq_iff, opens.empty_eq, opens.inter_eq, inf_bot_eq] at H,
    specialize H rfl ⟨x, hx⟩,
    erw Top.presheaf.germ_res_apply at H,
    exact H },
  { rintros X Y f hf,
    have e : (f.val.base) ⁻¹' set.range ⇑(f.val.base) = ⊤,
    { rw [← set.image_univ, set.preimage_image_eq _ hf.base_open.inj, set.top_eq_univ] },
    refine ⟨_, _, e, rfl, _⟩,
    rintros H hX s hs ⟨_, x, rfl⟩,
    unfreezingI { haveI := is_reduced_of_open_immersion f },
    specialize H (f.1.c.app _ s) _ ⟨x, by { change x ∈ (f.val.base) ⁻¹' _, rw e, trivial }⟩,
    { rw [← Scheme.preimage_basic_open, hs], ext1, simp [opens.map] },
    { erw ← PresheafedSpace.stalk_map_germ_apply f.1 ⟨_,_⟩ ⟨x,_⟩ at H,
      apply_fun (inv $ PresheafedSpace.stalk_map f.val x) at H,
      erw [category_theory.is_iso.hom_inv_id_apply, map_zero] at H,
      exact H } },
  { intros R hX s hs x,
    erw [basic_open_eq_of_affine', prime_spectrum.basic_open_eq_bot_iff] at hs,
    replace hs := (hs.map (Spec_Γ_identity.app R).inv),
    -- what the hell?!
    replace hs := @is_nilpotent.eq_zero _ _ _ _ (show _, from _) hs,
    rw coe_hom_inv_id at hs,
    rw [hs, map_zero],
    exact @@is_reduced.component_reduced hX ⊤ }
end

@[simp]
lemma basic_open_eq_bot_iff {X : Scheme} [is_reduced X] {U : opens X.carrier}
  (s : X.presheaf.obj $ op U) :
  X.basic_open s = ⊥ ↔ s = 0 :=
begin
  refine ⟨eq_zero_of_basic_open_empty s, _⟩,
  rintro rfl,
  simp,
end

/-- A scheme `X` is integral if its carrier is nonempty,
and `𝒪ₓ(U)` is an integral domain for each `U ≠ ∅`. -/
class is_integral : Prop :=
(nonempty : nonempty X.carrier . tactic.apply_instance)
(component_integral : ∀ (U : opens X.carrier) [_root_.nonempty U],
  is_domain (X.presheaf.obj (op U)) . tactic.apply_instance)

attribute [instance] is_integral.component_integral is_integral.nonempty

instance [h : is_integral X] : is_domain (X.presheaf.obj (op ⊤)) :=
@@is_integral.component_integral _ _ (by simp)

@[priority 900]
instance is_reduced_of_is_integral [is_integral X] : is_reduced X :=
begin
  constructor,
  intro U,
  cases U.1.eq_empty_or_nonempty,
  { have : U = ∅ := subtype.eq h,
    haveI := CommRing.subsingleton_of_is_terminal (X.sheaf.is_terminal_of_eq_empty this),
    change _root_.is_reduced (X.sheaf.val.obj (op U)),
    apply_instance },
  { haveI : nonempty U := by simpa, apply_instance }
end

instance is_irreducible_of_is_integral [is_integral X] : irreducible_space X.carrier :=
begin
  by_contradiction H,
  replace H : ¬ is_preirreducible (⊤ : set X.carrier) := λ h,
    H { to_preirreducible_space := ⟨h⟩, to_nonempty := infer_instance },
  simp_rw [is_preirreducible_iff_closed_union_closed, not_forall, not_or_distrib] at H,
  rcases H with ⟨S, T, hS, hT, h₁, h₂, h₃⟩,
  erw not_forall at h₂ h₃,
  simp_rw not_forall at h₂ h₃,
  haveI : nonempty (⟨Sᶜ, hS.1⟩ : opens X.carrier) := ⟨⟨_, h₂.some_spec.some_spec⟩⟩,
  haveI : nonempty (⟨Tᶜ, hT.1⟩ : opens X.carrier) := ⟨⟨_, h₃.some_spec.some_spec⟩⟩,
  haveI : nonempty (⟨Sᶜ, hS.1⟩ ⊔ ⟨Tᶜ, hT.1⟩ : opens X.carrier) :=
    ⟨⟨_, or.inl h₂.some_spec.some_spec⟩⟩,
  let e : X.presheaf.obj _ ≅ CommRing.of _ := (X.sheaf.is_product_of_disjoint ⟨_, hS.1⟩ ⟨_, hT.1⟩ _)
    .cone_point_unique_up_to_iso (CommRing.prod_fan_is_limit _ _),
  apply_with false_of_nontrivial_of_product_domain { instances := ff },
  { exact e.symm.CommRing_iso_to_ring_equiv.is_domain _ },
  { apply X.to_LocallyRingedSpace.component_nontrivial },
  { apply X.to_LocallyRingedSpace.component_nontrivial },
  { ext x,
    split,
    { rintros ⟨hS,hT⟩,
      cases h₁ (show x ∈ ⊤, by trivial),
      exacts [hS h, hT h] },
    { intro x, exact x.rec _ } }
end

lemma is_integral_of_is_irreducible_is_reduced [is_reduced X] [H : irreducible_space X.carrier] :
  is_integral X :=
begin
  split, refine λ U hU, ⟨λ a b e, _,
    (@@LocallyRingedSpace.component_nontrivial X.to_LocallyRingedSpace U hU).1⟩,
  simp_rw [← basic_open_eq_bot_iff, ← opens.not_nonempty_iff_eq_bot],
  by_contra' h,
  obtain ⟨_, ⟨x, hx₁, rfl⟩, ⟨x, hx₂, e'⟩⟩ := @@nonempty_preirreducible_inter _ H.1
    (X.basic_open a).2 (X.basic_open b).2
    h.1 h.2,
  replace e' := subtype.eq e',
  subst e',
  replace e := congr_arg (X.presheaf.germ x) e,
  rw [ring_hom.map_mul, ring_hom.map_zero] at e,
  refine @zero_ne_one (X.presheaf.stalk x.1) _ _ (is_unit_zero_iff.1 _),
  convert hx₁.mul hx₂,
  exact e.symm
end

lemma is_integral_iff_is_irreducible_and_is_reduced :
  is_integral X ↔ irreducible_space X.carrier ∧ is_reduced X :=
⟨λ _, by exactI ⟨infer_instance, infer_instance⟩,
  λ ⟨_, _⟩, by exactI is_integral_of_is_irreducible_is_reduced X⟩

lemma is_integral_of_open_immersion {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f]
  [is_integral Y] [nonempty X.carrier] : is_integral X :=
begin
  constructor,
  intros U hU,
  have : U = (opens.map f.1.base).obj (H.base_open.is_open_map.functor.obj U),
  { ext1, exact (set.preimage_image_eq _ H.base_open.inj).symm },
  rw this,
  haveI : is_domain (Y.presheaf.obj (op (H.base_open.is_open_map.functor.obj U))),
  { apply_with is_integral.component_integral { instances := ff },
    apply_instance,
    refine ⟨⟨_, _, hU.some.prop, rfl⟩⟩ },
  exact (as_iso $ f.1.c.app (op $ H.base_open.is_open_map.functor.obj U) :
    Y.presheaf.obj _ ≅ _).symm.CommRing_iso_to_ring_equiv.is_domain _
end

instance {R : CommRing} [H : is_domain R] : is_integral (Scheme.Spec.obj $ op R) :=
begin
  apply_with is_integral_of_is_irreducible_is_reduced { instances := ff },
  { apply_instance },
  { dsimp [Spec.Top_obj],
    apply_instance },
end

lemma affine_is_integral_iff (R : CommRing) :
  is_integral (Scheme.Spec.obj $ op R) ↔ is_domain R :=
⟨λ h, by exactI ring_equiv.is_domain ((Scheme.Spec.obj $ op R).presheaf.obj _)
  (as_iso $ to_Spec_Γ R).CommRing_iso_to_ring_equiv, λ h, by exactI infer_instance⟩

lemma is_integral_of_is_affine_is_domain [is_affine X] [nonempty X.carrier]
  [h : is_domain (X.presheaf.obj (op ⊤))] : is_integral X :=
begin
  haveI : is_integral (Scheme.Spec.obj (op (Scheme.Γ.obj (op X)))),
  { rw affine_is_integral_iff, exact h },
  exact is_integral_of_open_immersion X.iso_Spec.hom,
end

lemma map_injective_of_is_integral [is_integral X] {U V : opens X.carrier} (i : U ⟶ V)
  [H : nonempty U] :
  function.injective (X.presheaf.map i.op) :=
begin
  rw ring_hom.injective_iff,
  intros x hx,
  rw ← basic_open_eq_bot_iff at ⊢ hx,
  rw Scheme.basic_open_res at hx,
  revert hx,
  contrapose!,
  simp_rw [← opens.not_nonempty_iff_eq_bot, not_not],
  apply nonempty_preirreducible_inter U.prop (RingedSpace.basic_open _ _).prop,
  simpa using H
end

end algebraic_geometry


import LMT

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

example {a1 a2 a3 : A I E} :
        ((((a2).write i1 (v3)).write i2 (v3)).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} :
        ((((a1).write i3 (v2)).write i1 (v2)).read i3) ≠ (v2) → False := by
  arr


import LMT

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

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


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite C ∧ is_refinement A C, from by auto [euclidean_space.is_open_ball, euclidean_space.is_open_ball_iff, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_mem_nhds, euclidean_space.is_open_ball_iff_
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  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
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = 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
  -- Group has Latin Square Property
  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⁻¹],

  -- Setting $b = a$, this becomes:
  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],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from 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)-/


import unitb.code.syntax
import unitb.code.instances
import unitb.code.rules
import unitb.code.lemmas
import unitb.refinement.superposition
import unitb.category.transformer

import util.logic
import util.meta.tactic
import util.predicate
import util.data.subtype

import temporal_logic

namespace code.semantics

section
open code predicate temporal nondet

parameters (σ : Type)
@[reducible]
private def pred := pred' σ
parameters {p : nondet.program σ}
parameters {term : pred}
parameters {c : code p.lbl p.first term}

parameter Hterm : ∀ ae : p.lbl, term ⟹ -p.coarse_sch_of ae

structure state :=
  (pc : option (current c))
  (intl : σ)
  (assertion : assert_of pc intl)

parameter {σ}
parameter Hcorr : ∀ pc, state_correctness p c pc

-- include Hcorr

section event

parameter (e : p.lbl)
parameter (s : state)
parameter (h₀ : selects s.pc e)
parameter (h₁ : true)

section implicit

include h₁

theorem evt_guard
: p.guard e s.intl :=
(Hcorr s.pc).enabled e h₀ s.intl s.assertion

theorem evt_coarse_sch
: p.coarse_sch_of e s.intl :=
evt_guard.left

theorem evt_fine_sch
: p.fine_sch_of e s.intl :=
evt_guard.right

end implicit

def machine.run_event (s' : state) : Prop :=
(p.event $ some e).step s.intl evt_coarse_sch evt_fine_sch s'.intl

end event

def machine.step
  (e : current c)
  (s  : state)
  (h : some e = s.pc)
  (s' : state) : Prop :=
  s'.pc = next s.intl s.pc
∧ match action_of e with
   | (sum.inr ⟨l,hl⟩) :=
         have h : selects (s.pc) l,
              by { simp [h] at hl, apply hl },
         machine.run_event l s h trivial s'
   | (sum.inl _) := s'.intl = s.intl
  end

def machine.step_fis
  (e : current c)
  (s  : state)
  (h : some e = s.pc)
: ∃ (s' : state), machine.step e s h s' :=
begin
  destruct action_of e
  ; intros l Hl,
  { have Hss' : assert_of (next s.intl s.pc) s.intl,
    { rw assert_of_next,
      cases l with l H, cases H with P H,
      rw ← h,
      cases classical.em (condition (some e) P s.intl) with Hc Hnc,
      { apply (Hcorr $ some e).cond_true _ _ _ Hc,
        rw h,
        apply s.assertion, },
      { apply (Hcorr $ some e).cond_false _ _ _ Hnc,
        rw h,
        apply s.assertion } },
    let ss' := state.mk (next s.intl s.pc) s.intl Hss',
    existsi ss',
    unfold machine.step,
    split,
    { refl },
    { rw Hl, unfold machine.step._match_1 machine.run_event } },
  { cases l with l hl,
    rw h at hl,
    have CS := evt_coarse_sch Hcorr l s hl trivial,
    have FS := evt_fine_sch Hcorr l s hl trivial,
    cases (p.event l).fis s.intl CS FS with s' H,
    have Hss' : assert_of (next s.intl s.pc) s',
    { rw [assert_of_next],
      apply (Hcorr _).correct _ hl s.intl _ _ ⟨CS,FS,H⟩,
      apply s.assertion },
    let ss' := state.mk (next s.intl s.pc) s' Hss',
    existsi ss',
    unfold machine.step,
    split,
    { refl },
    { rw Hl, unfold machine.step._match_1 machine.run_event,
      apply H } }
end

def machine.event (cur : current c) : nondet.event state :=
  { coarse_sch := λ s, some cur = s.pc
  , fine_sch   := True
  , step := λ s hc _ s', machine.step cur s hc s'
  , fis  := λ s hc _, machine.step_fis cur s hc }

def mch_of : nondet.program state :=
 { lbl := current c
 , lbl_is_sched := by apply_instance
 , first := λ ⟨s₀,s₁,_⟩, s₀ = first c ∧ p.first s₁
 , first_fis :=
   begin cases p.first_fis with s Hs,
         have Hss : assert_of (first c) s,
         { rw assert_of_first, apply Hs },
         let ss := state.mk (first c) s Hss,
         existsi ss,
         unfold mch_of._match_1,
         exact ⟨rfl,Hs⟩
   end
 , event' := machine.event }

@[simp]
lemma coarse_sch_of_mch_of_some (e : mch_of.lbl)
: mch_of.coarse_sch_of (some e) = (λ s : state, some e = s.pc) :=
by { cases e ; refl }

lemma event_mch_of_some (e : mch_of.lbl)
: mch_of.event (some e) = machine.event e :=
by { cases e ; refl }

@[simp]
lemma fine_sch_of_mch_of (e : option mch_of.lbl)
: mch_of.fine_sch_of e = True :=
by { cases e ; refl }

@[simp]
lemma step_of_mch_of (e : mch_of.lbl) (s : state)
: mch_of.step_of (some e) s = (λ s', ∃ Hc : some e = s.pc, machine.step e s Hc s') :=
begin
  apply funext, intro s',
  dunfold code.semantics.mch_of program.step_of program.event program.event',
  dunfold code.semantics.machine.event nondet.event.step_of,
  dunfold event.coarse_sch event.fine_sch event.step,
  apply iff.to_eq,
  apply exists_congr ,
  intro Hc ,
  dsimp [True_eq_true] ,
  rw exists_true,
end

lemma step_event'_mch_of_imp_pc_eq_next (e : mch_of.lbl) (s s' : state)
  (Hc : mch_of.coarse_sch_of (some e) s)
  (Hf : mch_of.fine_sch_of (some e) s)
  (H : (mch_of.event' e).step s Hc Hf s')
: s'.pc = next s.intl s.pc :=
H.left

open superposition

def rel (l : option mch_of.lbl) : option p.lbl → Prop
  | (some e) := selects l e
  | none     := is_control l ∨ l = none

lemma ref_sim (ec : option mch_of.lbl)
: ⟦mch_of.step_of ec⟧ ⟹
      ∃∃ (ea : {ea // rel ec ea}), ⟦p.step_of (ea.val) on state.intl⟧ :=
begin
  rw exists_action,
  apply action_entails_action,
  intros s s' H,
  cases ec with pc,
  case none
  { let x : {ea // rel Hcorr none ea},
    { existsi none, unfold rel is_control, right, refl },
    existsi x, unfold function.on_fun,
    unfold mch_of nondet.program.step_of nondet.program.event
           nondet.skip nondet.event.step_of
           nondet.event.fine_sch nondet.event.coarse_sch
           nondet.event.step  at H,
    unfold nondet.program.step_of nondet.program.event
           nondet.skip nondet.event.step_of
           nondet.event.fine_sch nondet.event.coarse_sch
           nondet.event.step,
    apply exists_imp_exists' (assume _, trivial) _ H, intro,
    apply exists_imp_exists' (assume _, trivial) _, intros _,
    simp, intro, subst s, },
  case some
  { destruct action_of pc,
    case sum.inl
    { intros c Hact,
      cases c with c Hc,
      cases Hc with P Hc,
      let x : {ea // rel Hcorr (some pc) ea},
      { existsi none, unfold rel is_control, left, apply P },
      existsi x,
      unfold function.on_fun nondet.program.step_of nondet.program.event
             nondet.event.step_of,
      unfold nondet.program.step_of nondet.program.event
             nondet.event.step_of at H,
      apply exists_imp_exists' (assume _, trivial) _ H, intro,
      apply exists_imp_exists' (assume _, trivial) _, intros _,
      intros H',
      change _ = _,
      dunfold code.semantics.mch_of nondet.program.event'
              code.semantics.machine.event
              nondet.event.step
              code.semantics.machine.step at H',
      rw Hact at H',
      symmetry, apply H'.right, },
    case sum.inr
    { intros e Hact,
      cases e with e He,
      let x : {ea // rel Hcorr (some pc) ea},
      { existsi (some e), apply He },
      existsi x, unfold function.on_fun,
      dunfold code.semantics.mch_of nondet.program.step_of nondet.program.event
              nondet.program.event' code.semantics.machine.event nondet.event.step_of
              nondet.event.coarse_sch nondet.event.fine_sch
              nondet.event.step at H,
      cases H with Hc H, cases H with Hf H,
      dunfold code.semantics.machine.step at H,
      rw Hact at H, unfold machine.step._match_1 machine.run_event at H,
      rw Hc at He,
      have Hen := (Hcorr s.pc).enabled e He _ s.assertion,
      exact ⟨Hen.left,Hen.right,H.right⟩, }, },
end

section ref_resched

parameter ea : option p.lbl

variable ec : { ec // rel ec ea }

section leads_to

open unitb
parameter pc : current c
parameters p' q' : pred
parameter c' : code p.lbl p' q'
parameter H : subtree c' c
parameter e : p.lbl

@[reducible]
def lt_sched := except (λ s : state, selects s.pc e) (leads_to mch_of)

@[trans]
def lt_sched_trans
  {α} (β) {γ : pred' state}
  (h₀ : lt_sched α β)
  (h₁ : lt_sched β γ)
: lt_sched α γ :=
h₁ <<< h₀

local infix `  ↦.  `:60 := lt_sched

lemma evt_leads_to_aux
: (λ s : state, within H s.pc)
    ↦.
  (λ s : state, exits H s.pc) :=
begin
  induction c',
  case code.skip
  { apply lifted_pred.imp,
    intro s,
    apply not_within_skip },
  case code.action
  { apply except_lift,
    apply @ensure_rule _ (mch_of Hcorr) _ _ (some (counter H)),
      -- EN
    { rw coarse_sch_of_mch_of_some,
      intro s, simp [not_or_iff_not_and_not,and_shunting,exits],
      intros H₀ H₁,
      apply counter_action_of_within H₀ H₁, },
      -- FLW
    { simp [fine_sch_of_mch_of],
      apply leads_to.trivial },
      -- STEP
    { intros s s' Hp Hstep,
      rw step_of_mch_of at Hstep,
      cases Hstep with Hc Hstep,
      unfold machine.step at Hstep,
      cases Hstep with Hstep₀ Hstep₁,
      rw [Hstep₀,← Hc],
      rw next_counter_action,
      unfold exits, },
      -- STABLE
    { apply unless_rule,
      intros ec s Hc Hf s' Hstep Hp,
--      rw [not_or_iff_not_and_not,and_shunting],
      intros Hnq₀,
      right,
      unfold exits,
      have Hp := counter_action_of_within Hp Hnq₀,
      rw [← next_counter_action s.intl H, Hp],
      symmetry,
      apply Hstep.left, }, },
  case code.seq p₀ q r c₀ c₁ ih_1 ih_2 H
  { have Pright : lt_sched Hcorr e
                  (λ (s : state), within H.right (s.pc))
                  (λ (s : state), exits H (s.pc)),
    { simp [exits_iff_exits_right],
      apply ih_2 H.right },
    have Pleft : lt_sched Hcorr e
                 (λ (s : state), within H.left (s.pc))
                 (λ (s : state), exits H (s.pc)),
    { apply lt_sched_trans Hcorr e (λ (s : state), exits H.left (s.pc)),
      { apply ih_1 },
      apply antimono_left,
      { intro, apply exits_left_imp_within_right H },
      { apply Pright } },
    simp [within_left_or_within_right_iff_within_seq],
    apply disj _ Pleft Pright, },
  case code.if_then_else
  { admit },
  case code.while
  { admit },
end

end leads_to

open unitb
include Hterm

lemma evt_leads_to
: (p.coarse_sch_of ea ⋀ (p.event ea).fine_sch) ∘ state.intl
    ↦
      -(p.coarse_sch_of ea ∘ state.intl)
      ⋁ ∃∃ ec : { ec // rel ec ea }, mch_of.coarse_sch_of ec.val
   in mch_of :=
begin
  cases ea with ea,
  { apply unitb.leads_to.imp,
    apply entails_p_or_of_entails_right,
    intros s h, simp,
    let ec : {ec // rel Hcorr ec none},
    { existsi none, apply or.inr, refl },
    existsi [ec.val,ec.property], unfold_local ec,
    simp },
  have H := (evt_leads_to_aux Hcorr _ _ c subtree.rfl ea).run,
  revert H,
  apply unitb.leads_to.monotonicity,
  { intros s q,
    apply within_rfl },
  apply p_or_entails_p_or,
  { -- type_check (term ∘ state.intl),
    -- type_check entails_trans (term ∘ state.intl),
    refine entails_trans (term ∘ state.intl) _ _,
    { intro s, simp [exits],
      intro H,
      have Hasrt := s.assertion,
      rw ← H at Hasrt,
      apply Hasrt, },
    { rw p_not_comp,
      refine comp_entails_comp _ _,
      apply Hterm }, },
  { intros s h,
    let ec : {ec // rel Hcorr ec (some ea)},
    { existsi s.pc, apply h, },
    apply p_exists_intro ec,
    revert ec, simp,
    destruct s.pc,
    { intros h, simp [h], },
    { intros ec Hec, simp [Hec], }, },
end

omit Hterm

lemma evt_resched
: (p.coarse_sch_of ea ⋀ p.fine_sch_of ea) ∘ state.intl ⋀ True
  ⋀ mch_of.coarse_sch_of ec
    >~>
      mch_of.fine_sch_of ec  in  mch_of :=
begin
  simp,
  apply unitb.often_imp_often.basis,
  apply unitb.leads_to.trivial,
end

include Hterm

lemma evt_delay
: (p.coarse_sch_of ea ⋀ (p.event ea).fine_sch) ∘ state.intl
    >~>
      -(p.coarse_sch_of ea ∘ state.intl)
      ⋁ ∃∃ ec : { ec // rel ec ea }, True ⋀ mch_of.coarse_sch_of ec.val
   in mch_of :=
begin
  simp,
  apply often_imp_often.basis,
  apply evt_leads_to Hterm Hcorr ea,
end

omit Hterm

lemma evt_stable
: unless_except mch_of
      (True ⋀ mch_of.coarse_sch_of ec)
      (-(p.coarse_sch_of ea ∘ state.intl))
      { e | ∃ (l : {ec // rel ec ea}), mch_of.event l = e } :=
begin
  apply unless_except_rule,
  intros e s Hc Hf s' Hexcp H₀ H₁ H₂,
  simp [function.comp],
  simp [mem_set_of,not_exists_iff_forall_not] at Hexcp,
  simp [program.event,mch_of,machine.event,program.coarse_sch_of] at H₁ Hc,
  cases ec with ec Hec,
  specialize Hexcp ec Hec,
  cases ec with ec,
  { right, trivial, },
  simp at H₁,
  exfalso, apply Hexcp,
  dsimp [program.event,code.semantics.mch_of,program.event,machine.event] at H₁ Hc,
  rw ← Hc at H₁,
  rw H₁,
  refl
end

lemma evt_sim
:    ⟦mch_of.step_of (ec.val)⟧
 ⟹ ⟦p.step_of ea on state.intl⟧ :=
begin
  apply action_entails_action,
  intros s s',
  dunfold function.on_fun,
  cases ec with ec Hec,
  cases ea,
  case some ea
  { dunfold code.semantics.rel at Hec,
    cases ec with ec,
    { cases Hec },
    { unfold_projs,
      have Hgrd : (machine.event Hcorr ec).coarse_sch s
                → (p.event' ea).guard (s.intl),
      { unfold machine.event,
        unfold nondet.event.coarse_sch, intro H,
        rw H at Hec,
        apply (Hcorr s.pc).enabled _ Hec,
        apply s.assertion },
      have Hcs : (machine.event Hcorr ec).coarse_sch s
               → (p.event' ea).coarse_sch (s.intl),
      { apply and.left ∘ Hgrd },
      rw [step_of_mch_of],
      apply exists_imp_exists' Hcs,
      intros Hcs,
      have Hfs : (p.event' ea).fine_sch (s.intl),
      { apply (Hgrd Hcs).right },
      simp [machine.step],
      destruct action_of ec,
      case sum.inr
      { intros ea' Hea, cases ea' with ea' Hea',
        simp [Hea,machine.step._match_1,machine.run_event],
        intros ea'' Hea'',
        simp [nondet.program.event,mch_of,nondet.program.event'] at *,
        existsi Hfs,
        have H := selects_and_selects_imp_eq _ Hec Hea',
        subst ea', assumption, },
      case sum.inl
      { intros pc Hea, rw Hea,
        simp [machine.step._match_1],
        intros H₀ _, rw H₀,
        cases pc with pc P, cases P with P₀ P₁,
        cases not_selects_and_is_control Hec P₀, } } },
  case none
  { cases ec with ec ;
    simp [program.event],
    { have Hcs : nondet.skip.coarse_sch s → nondet.skip.coarse_sch s.intl,
      { apply id },
      intros Hcs', subst s, },
    { unfold rel at Hec,
      cases Hec,
      case or.inl Hec
        { intros Hc Hstep,
          destruct (action_of ec),
          case sum.inr
            { intros ea Hea₀,
              cases ea with ea Hea₁,
              cases not_selects_and_is_control Hea₁ Hec },
          case sum.inl
            { intros ea Hea,
              simp [Hea,machine.step,machine.step._match_1] at Hstep,
              rw Hstep.left  } },
      case or.inr Hec
        { contradiction } } }
end

lemma ref_resched
: evt_ref_wk state.intl {ec // rel ec ea} mch_of (p.event ea)
      (λ (ec : {ec // rel ec ea}), mch_of.event (ec.val)) :=
{ witness := λ _, True
, resched := evt_resched
, stable  := evt_stable
, delay   := evt_delay
, sim     := evt_sim }

end ref_resched

lemma code_refs_machine
: refined state.intl p mch_of :=
{ sim_init := by { intros i, cases i, apply and.right, }
, ref := rel
, evt_sim := ref_sim
, events := ref_resched }

end

end code.semantics


import LMT

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

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


import LMT

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

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


import condensed.Qprime_isoms

.

noncomputable theory

universes v u u₁ u₂

open category_theory category_theory.limits breen_deligne opposite
open bounded_homotopy_category

namespace Condensed

variables (BD : package)
variables (M N : Condensed.{u} Ab.{u+1}) (f : M ⟶ N)

lemma homology_functor_iso_natural'
  (C₁ C₂ : cochain_complex (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) ℤ) (g : C₁ ⟶ C₂)
  (S : Profinite.{u}ᵒᵖ) (i : ℤ) :
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso (complex_shape.up ℤ) i).inv.app C₁ ≫
  ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) (complex_shape.up ℤ) i).map g).app S =
  category_theory.functor.map _ g ≫
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso (complex_shape.up ℤ) i).inv.app C₂ :=
((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj S).homology_functor_iso _ i).inv.naturality g).symm

lemma homology_functor_iso_natural (S : ExtrDiscᵒᵖ) (i : ℤ) :
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
      (op (unop S).val)).homology_functor_iso (complex_shape.up ℤ) i).inv.app
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) ≫
  ((homology_functor (Profiniteᵒᵖ ⥤ Ab) (complex_shape.up ℤ) i).map
     ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).app
    (ExtrDisc_to_Profinite.op.obj S) =
  category_theory.functor.map _ (category_theory.functor.map _ (category_theory.functor.map _ f)) ≫
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
        (op (unop S).val)).homology_functor_iso (complex_shape.up ℤ) i).inv.app
      ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj N)) :=
homology_functor_iso_natural' _ _ _ _ _
.

lemma eval_freeAb_iso_component_natural_zero (S : ExtrDiscᵒᵖ) :
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
        (complex_shape.up ℤ)).map
       ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f
      (int.of_nat 0) ≫
    (eval_freeAb_iso.component_zero BD N (unop S)).hom =
  (eval_freeAb_iso.component_zero BD M (unop S)).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
       (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val)).f
      (int.of_nat 0) :=
begin
  dsimp only [eval_freeAb_iso.component_zero,
    functor.map_homological_complex_map_f, category_theory.evaluation_obj_map],
  erw [embed_f_0, embed_f_0],
  simp only [functor.map_biproduct, data.eval_functor_obj_map_f,
    whiskering_right_obj_map, whisker_right_app, functor.comp_map,
    functor.map_iso_hom, biproduct.unique_up_to_iso_hom,
    ← functor.map_comp], congr' 2,
  apply biproduct.hom_ext, intro j,
  simp only [category.assoc],
  erw [biproduct.lift_π, biproduct.map_π, biproduct.lift_π_assoc],
  simp only [functor.map_bicone_π, biproduct.bicone_π, evaluation_obj_map],
  simp only [← nat_trans.comp_app], congr' 1,
  rw [biproduct.map_π], refl,
end

lemma eval_freeAb_iso_component_natural_neg (S : ExtrDiscᵒᵖ) (n : ℕ) :
((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
        (complex_shape.up ℤ)).map
       ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f
      -[1+ n] ≫
    (eval_freeAb_iso.component_neg BD N (unop S) n).hom =
  (eval_freeAb_iso.component_neg BD M (unop S) n).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
       (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val)).f
      -[1+ n] :=
begin
  dsimp only [eval_freeAb_iso.component_neg,
    functor.map_homological_complex_map_f, category_theory.evaluation_obj_map],
  erw [embed_f_neg, embed_f_neg],
  simp only [functor.map_biproduct, data.eval_functor_obj_map_f,
    whiskering_right_obj_map, whisker_right_app, functor.comp_map,
    functor.map_iso_hom, biproduct.unique_up_to_iso_hom,
    ← functor.map_comp], congr' 2,
  apply biproduct.hom_ext, intro j,
  simp only [category.assoc],
  erw [biproduct.lift_π, biproduct.map_π, biproduct.lift_π_assoc],
  simp only [functor.map_bicone_π, biproduct.bicone_π, evaluation_obj_map],
  simp only [← nat_trans.comp_app], congr' 1,
  rw [biproduct.map_π], refl,
end

lemma eval_freeAb_iso_component_natural (S : ExtrDiscᵒᵖ) :
(eval_freeAb_iso_component BD M (unop S)).inv ≫
    (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map_homological_complex
       (complex_shape.up ℤ)).map
      ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f)) =
  (BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
      (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op (unop S).val)).map f.val) ≫
    (eval_freeAb_iso_component BD N (unop S)).inv :=
begin
  rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv],
  ext ((_|n)|n) : 2,
  { apply eval_freeAb_iso_component_natural_zero },
  { apply is_zero.eq_of_tgt, apply is_zero_zero, },
  { apply eval_freeAb_iso_component_natural_neg },
end
.

lemma eval_freeAb_iso_component_natural_bis (S : ExtrDiscᵒᵖ) (i : ℤ) :
  (homology_functor AddCommGroup (complex_shape.up ℤ) i).map (eval_freeAb_iso_component BD M (unop S)).inv ≫
  (((category_theory.evaluation Profiniteᵒᵖ Ab).obj (op (unop S).val)).map_homological_complex
       (complex_shape.up ℤ) ⋙
     homology_functor Ab (complex_shape.up ℤ) i).map
    ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f)) =
  category_theory.functor.map _ (category_theory.functor.map _ (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
      (op (unop S).val)).map f.val)) ≫
    (homology_functor AddCommGroup (complex_shape.up ℤ) i).map (eval_freeAb_iso_component BD N (unop S)).inv :=
begin
  rw [functor.comp_map, ← functor.map_comp, ← functor.map_comp], congr' 1,
  apply eval_freeAb_iso_component_natural,
end

lemma tensor_to_unsheafified_homology_natural'_aux (S : ExtrDiscᵒᵖ) (x) :
  ((AddCommGroup.adj.hom_equiv punit (N.val.obj (op (unop S).val))).symm)
  (point
     ((((ExtrSheaf_ExtrSheafProd_equiv Ab).functor.map ((Condensed_ExtrSheaf_equiv Ab).inverse.map f)).val.app S) x)) =
  ((AddCommGroup.adj.hom_equiv punit (M.val.obj (op (unop S).val))).symm) (point x) ≫
    ((category_theory.evaluation Profiniteᵒᵖ Ab).obj (op (unop S).val)).map f.val :=
begin
  dsimp [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv],
  apply free_abelian_group.lift.ext, rintro ⟨⟩,
  rw [free_abelian_group.lift.of, comp_apply, free_abelian_group.lift.of],
  refl
end

lemma aaaahrg (i : ℤ) {A B : Ab} (f : A ⟶ B) :
  (homotopy_category.homology_functor AddCommGroup (complex_shape.up ℤ) i).map
  ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).map f) =
  (homology_functor AddCommGroup (complex_shape.up ℤ) i).map
  ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map f) :=
rfl

lemma tensor_to_unsheafified_homology_natural' (i : ℤ) :
  tensor_to_unsheafified_homology BD M i ≫
    whisker_left ExtrDisc_to_Profinite.op
      ((homology_functor (Profiniteᵒᵖ ⥤ Ab) (complex_shape.up ℤ) i).map
         ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))) =
  (ExtrSheafProd.map_tensor
    ((ExtrSheaf_ExtrSheafProd_equiv Ab).functor.map ((Condensed_ExtrSheaf_equiv Ab).inverse.map f))
      (𝟙 (((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj (AddCommGroup.free.obj punit)).val.as.homology i))).val ≫
    tensor_to_unsheafified_homology BD N i :=
begin
  ext S : 2,
  dsimp only [tensor_to_unsheafified_homology, nat_trans.comp_app, whisker_left_app,
    ExtrSheafProd.map_tensor_val_app],
  apply AddCommGroup.tensor_ext, intros x y,
  simp only [comp_apply, id_apply, AddCommGroup.map_tensor, tensor_product.map_tmul,
    AddCommGroup.tensor_uncurry, linear_map.to_add_monoid_hom_coe,
    tensor_product.lift.tmul, add_monoid_hom.coe_mk,
    linear_map.comp_apply, add_monoid_hom.coe_to_int_linear_map],
  dsimp only [tensor_to_unsheafified_homology_component, add_monoid_hom.mk'_apply,
    tensor_to_unsheafified_homology_component_applied],
  simp only [← comp_apply, category.assoc], congr' 1,
  rw homology_functor_iso_natural,
  simp only [← category.assoc], congr' 1, simp only [category.assoc],
  rw eval_freeAb_iso_component_natural_bis,
  simp only [← category.assoc], congr' 1,
  rw [tensor_to_unsheafified_homology_natural'_aux],
  rw [aaaahrg, aaaahrg, ← category_theory.functor.map_comp, ← category_theory.functor.map_comp],
end

lemma tensor_to_homology_natural (i : ℤ) :
  tensor_to_homology.{u} BD M i ≫ (homology_functor (Condensed.{u} Ab.{u+1}) _ i).map
      ((BD.eval' freeCond').map f) =
  map_tensor f (𝟙 _) ≫ tensor_to_homology.{u} BD N i :=
begin
  simp only [tensor_to_homology, category.assoc, ← functor.map_comp,
    eval_freeCond'_iso_component_natural],
  simp only [functor.map_comp],
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  have := (homology_functor_sheafification_iso (complex_shape.up ℤ) i).hom.naturality
    ((Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc).map f),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  dsimp only [iso.app_hom],
  have := (Condensed_ExtrSheaf_equiv Ab.{u+1}).counit_iso.hom.naturality
    ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) _ i ⋙
      presheaf_to_Condensed_Ab).map ((Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc.{u u+1}).map f)),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl, simp only [category.assoc],
  dsimp only [map_tensor, functor.comp_map],
  simp only [← functor.map_comp], congr' 1,
  have := ExtrDisc_sheafification_iso.hom.naturality
    ((homology_functor (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) _ i).map
      ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))),
  erw [← this], clear this,
  simp only [← category.assoc], refine congr_arg2 _ _ rfl,
  ext1,
  dsimp only [tensor_to_homology_aux],
  simp only [functor.comp_map, whiskering_left_obj_map, Sheaf.category_theory.category_comp_val,
    presheaf_to_Sheaf_map_val, ExtrSheaf.map_tensor_val,
    grothendieck_topology.to_sheafify_naturality, category.assoc,
    grothendieck_topology.to_sheafify_naturality_assoc, ← grothendieck_topology.sheafify_map_comp],
  rw [tensor_to_unsheafified_homology_natural'],
end

lemma homology_bd_eval_natural
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (M.val.obj (op S.val))]
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (N.val.obj (op S.val))] (i : ℤ) :
  (homology_bd_eval BD M i).inv ≫ (homology_functor _ _ i).map ((BD.eval' freeCond').map f) =
  map_tensor f (𝟙 _) ≫ (homology_bd_eval BD N i).inv :=
tensor_to_homology_natural BD M N f i

end Condensed


import Lean
import Duper.DUnif.UnifRules
open Lean

namespace DUnif

-- Note: This is copied from standard library with some code
--       removed to make it simpler and a few lines changed to
--       allow for higher-order unification

private def throwApplyError {α} (mvarId : MVarId) (eType : Expr) (targetType : Expr) : MetaM α :=
  Meta.throwTacticEx `apply mvarId m!"failed to unify{indentExpr eType}\nwith{indentExpr targetType}"

/--
Close the given goal using `apply e`.
-/
def execdapply (mvarId : MVarId) (e : Expr) (nAttempt : Nat) (nUnif : Nat) (cont : Nat) (cfg : Meta.ApplyConfig := {}) : MetaM (List MVarId) :=
  mvarId.withContext do
    mvarId.checkNotAssigned `apply
    let targetType ← mvarId.getType
    let targetMVars ← Meta.getMVarsNoDelayed targetType
    let eType      ← Meta.inferType e
    let (numArgs, hasMVarHead) ← Meta.getExpectedNumArgsAux eType
    /-
    The `apply` tactic adds `_`s to `e`, and some of these `_`s become new goals.
    When `hasMVarHead` is `false` we try different numbers, until we find a type compatible with `targetType`.
    We used to try only `numArgs-targetTypeNumArgs` when `hasMVarHead = false`, but this is not always correct.
    For example, consider the following example
    ```
    example {α β} [LE_trans β] (x y z : α → β) (h₀ : x ≤ y) (h₁ : y ≤ z) : x ≤ z := by
      apply le_trans
      assumption
      assumption
    ```
    In this example, `targetTypeNumArgs = 1` because `LE` for functions is defined as
    ```
    instance {α : Type u} {β : Type v} [LE β] : LE (α → β) where
      le f g := ∀ i, f i ≤ g i
    ```
    -/
    let rangeNumArgs ← if hasMVarHead then
      pure [numArgs : numArgs+1]
    else
      let targetTypeNumArgs ← Meta.getExpectedNumArgs targetType
      pure [numArgs - targetTypeNumArgs : numArgs+1]
    /-
    Auxiliary function for trying to add `n` underscores where `n ∈ [i: rangeNumArgs.stop)`
    See comment above
    -/
    let rec go (i : Nat) : MetaM (Array Expr × Array BinderInfo) := do
      if i < rangeNumArgs.stop then
        let s ← saveState
        let (newMVars, binderInfos, eType) ← Meta.forallMetaTelescopeReducing eType i
        if (← hounif eType targetType nAttempt nUnif cont true) then
          return (newMVars, binderInfos)
        else
          s.restore
          go (i+1)
      else
        let (_, _, eType) ← Meta.forallMetaTelescopeReducing eType (some rangeNumArgs.start)
        throwApplyError mvarId eType targetType
    let (newMVars, binderInfos) ← go rangeNumArgs.start
    Meta.postprocessAppMVars `apply mvarId newMVars binderInfos cfg.synthAssignedInstances
    let e ← instantiateMVars e
    mvarId.assign (mkAppN e newMVars)
    let newMVars ← newMVars.filterM fun mvar => not <$> mvar.mvarId!.isAssigned
    -- Collect other mvars
    let mut otherMVarIds ← Meta.getMVarsNoDelayed e
    for m in targetMVars do
      for mvarId in (← Meta.getMVarsNoDelayed (.mvar m)) do
        if !otherMVarIds.contains mvarId then
          otherMVarIds := otherMVarIds.push mvarId
    let newMVarIds := (newMVars.map (·.mvarId!)).data
    otherMVarIds := otherMVarIds.filter fun mvarId => !newMVarIds.contains mvarId
    let result := newMVarIds ++ otherMVarIds.toList
    trace[Meta.Tactic] "{result}"
    result.forM (·.headBetaType)
    return result
termination_by go i => rangeNumArgs.stop - i

syntax (name := dapply) "dapply " term " attempt " num "unifier " num "contains" num : tactic

@[tactic dapply]
def evaldapply : Elab.Tactic.Tactic := fun stx =>
  match stx with
  | `(tactic| dapply $e attempt $nAttempt unifier $nunif contains $cont) => Elab.Tactic.withMainContext do
    let mut val ← instantiateMVars (← Elab.Tactic.elabTermForApply e)
    if val.isMVar then
      Elab.Term.synthesizeSyntheticMVarsNoPostponing
      val ← instantiateMVars val
    let mvarIds' ← execdapply (← Elab.Tactic.getMainGoal) val nAttempt.getNat nunif.getNat cont.getNat
    Elab.Term.synthesizeSyntheticMVarsNoPostponing
    Elab.Tactic.replaceMainGoal mvarIds'
  | _ => Elab.throwUnsupportedSyntax


import analysis.normed.group.SemiNormedGroup.kernels
import algebra.homology.additive

namespace SemiNormedGroup

protected class strict_iso {A B : SemiNormedGroup} (f : A ≅ B) :=
(strict_hom' : ∀ a : A, ∥f.hom a∥₊ = ∥a∥₊)

@[simp]
lemma strict_iso_hom {A B : SemiNormedGroup} (f : A ≅ B) [strict_iso f] (a : A) :
  ∥f.hom a∥₊ = ∥a∥₊ := strict_iso.strict_hom' _

@[simp]
lemma strict_iso_inv {A B : SemiNormedGroup} (f : A ≅ B) [strict_iso f] (b : B) :
  ∥f.inv b∥₊ = ∥b∥₊ :=
begin
  have : b = f.hom (f.inv b),
  { change b = (f.inv ≫ f.hom) b, simp },
  conv_rhs {rw this},
  rw strict_iso_hom,
end

end SemiNormedGroup

structure strict_iso (C D : cochain_complex SemiNormedGroup ℕ) :=
(iso : C ≅ D)
[is_strict : ∀ i : ℕ, SemiNormedGroup.strict_iso $ (homological_complex.eval _ _ i).map_iso iso]

instance (C D : cochain_complex SemiNormedGroup ℕ) (f : strict_iso C D) (n : ℕ) :
  SemiNormedGroup.strict_iso ((homological_complex.eval _ _ n).map_iso f.iso) := f.is_strict _


import LMT

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

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


import LMT

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

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


import LMT

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

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


variables x : Type

constant duh : ℕ
constant doh : ℕ
constant dah : ℕ

lemma exercise : x = x := by sorry

lemma exercise2 : 1 + 1 = 2 := by sorry


lemma eq_mp_heq :
  ∀ {α β : Sort*} {a : α} {a' : β} (h₂ : a == a'), (eq.mp (type_eq_of_heq h₂) a) = a'
| α ._ a a' heq.rfl := rfl


/-
File: signature_recover_public_key_get_point_from_x_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
import .signature_recover_public_key_validate_reduced_field_element_soundness
import .signature_recover_public_key_reduce_soundness
import .signature_recover_public_key_unreduced_sqr_soundness
import .signature_recover_public_key_unreduced_mul_soundness
open tactic

open starkware.cairo.common.cairo_secp.signature
open starkware.cairo.common.cairo_secp.constants
open starkware.cairo.common.math
open starkware.cairo.common.cairo_secp.field
open starkware.cairo.common.cairo_secp.ec
open starkware.cairo.common.cairo_secp.bigint

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.cairo_secp.signature.get_point_from_x autogenerated soundness theorem -/

theorem auto_sound_get_point_from_x
    -- arguments
    (range_check_ptr : F) (x : BigInt3 F) (v : F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_get_point_from_x σ.pc)
    -- all dependencies are in memory
    (h_mem_0 : mem_at mem code_assert_nn (σ.pc  - 751))
    (h_mem_1 : mem_at mem code_assert_le (σ.pc  - 747))
    (h_mem_2 : mem_at mem code_assert_nn_le (σ.pc  - 742))
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 719))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 707))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 687))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 671))
    (h_mem_9 : mem_at mem code_reduce (σ.pc  - 612))
    (h_mem_10 : mem_at mem code_validate_reduced_field_element (σ.pc  - 599))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 7))
    (hin_x : x = cast_BigInt3 mem (σ.fp - 6))
    (hin_v : v = mem (σ.fp - 3))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 7)) (mem $ τ.ap - 7)
        (spec_get_point_from_x mem κ range_check_ptr x v (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_get_point_from_x at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65⟩,
  -- ap += 6
  step_advance_ap hpc0 hpc1,
  -- function call
  step_assert_eq hpc2 with arg0,
  step_assert_eq hpc3 with arg1,
  step_sub hpc4 (auto_sound_assert_nn mem _ range_check_ptr v _ _ _),
  { rw hpc5, norm_num2, exact h_mem_0 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call6 ap6 h_call6,
  rcases h_call6 with ⟨h_call6_ap_offset, h_call6⟩,
  rcases h_call6 with ⟨rc_m6, rc_mle6, hl_range_check_ptr₁, h_call6⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap6 - 1) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at h_call6 },
  rw [hin_range_check_ptr] at h_call6,
  clear arg0 arg1,
  -- function call
  step_assert_eq hpc6 with arg0,
  step_assert_eq hpc7 with arg1,
  step_assert_eq hpc8 with arg2,
  step_sub hpc9 (auto_sound_unreduced_sqr mem _ x _ _),
  { rw hpc10, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2] },
      try { simp only [h_call6_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call11 ap11 h_call11,
  rcases h_call11 with ⟨h_call11_ap_offset, h_call11⟩,
  generalize' hr_rev_x_square: cast_UnreducedBigInt3 mem (ap11 - 3) = x_square,
  simp only [hr_rev_x_square] at h_call11,
  have htv_x_square := hr_rev_x_square.symm, clear hr_rev_x_square,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc11 with arg0,
  step_assert_eq hpc12 with arg1,
  step_assert_eq hpc13 with arg2,
  step_assert_eq hpc14 with arg3,
  step_sub hpc15 (auto_sound_reduce mem _ range_check_ptr₁ x_square _ _ _ _ _),
  { rw hpc16, norm_num2, exact h_mem_9 },
  { rw hpc16, norm_num2, exact h_mem_4 },
  { rw hpc16, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call17 ap17 h_call17,
  rcases h_call17 with ⟨h_call17_ap_offset, h_call17⟩,
  rcases h_call17 with ⟨rc_m17, rc_mle17, hl_range_check_ptr₂, h_call17⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap17 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_x_square_reduced: cast_BigInt3 mem (ap17 - 3) = x_square_reduced,
  simp only [hr_rev_x_square_reduced] at h_call17,
  have htv_x_square_reduced := hr_rev_x_square_reduced.symm, clear hr_rev_x_square_reduced,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at hl_range_check_ptr₂ },
  try { rw [h_call11_ap_offset] at hl_range_check_ptr₂ }, try { arith_simps at hl_range_check_ptr₂ },
  rw [←htv_range_check_ptr₂, ←htv_range_check_ptr₁] at hl_range_check_ptr₂,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at h_call17 },
  try { rw [h_call11_ap_offset] at h_call17 }, try { arith_simps at h_call17 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call17,
  clear arg0 arg1 arg2 arg3,
  -- function call
  step_assert_eq hpc17 with arg0,
  step_assert_eq hpc18 with arg1,
  step_assert_eq hpc19 with arg2,
  step_assert_eq hpc20 with arg3,
  step_assert_eq hpc21 with arg4,
  step_assert_eq hpc22 with arg5,
  step_sub hpc23 (auto_sound_unreduced_mul mem _ x x_square_reduced _ _ _),
  { rw hpc24, norm_num2, exact h_mem_5 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call25 ap25 h_call25,
  rcases h_call25 with ⟨h_call25_ap_offset, h_call25⟩,
  generalize' hr_rev_x_cube: cast_UnreducedBigInt3 mem (ap25 - 3) = x_cube,
  simp only [hr_rev_x_cube] at h_call25,
  have htv_x_cube := hr_rev_x_cube.symm, clear hr_rev_x_cube,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- local var
  step_assert_eq hpc25 with temp0,
  step_assert_eq hpc26 with temp1,
  step_assert_eq hpc27 with temp2,
  have lc_x_cube: x_cube = cast_UnreducedBigInt3 mem σ.fp, {
    try { ext } ; {
      try { simp only [htv_x_cube] },
      try { dsimp [cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2,
  -- function call
  step_assert_eq hpc28 with arg0,
  step_sub hpc29 (auto_sound_nondet_bigint3 mem _ range_check_ptr₂ _ _),
  { rw hpc30, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call31 ap31 h_call31,
  rcases h_call31 with ⟨h_call31_ap_offset, h_call31⟩,
  rcases h_call31 with ⟨rc_m31, rc_mle31, hl_range_check_ptr₃, h_call31⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap31 - 4) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_y: cast_BigInt3 mem (ap31 - 3) = y,
  simp only [hr_rev_y] at h_call31,
  have htv_y := hr_rev_y.symm, clear hr_rev_y,
  try { simp only [arg0] at hl_range_check_ptr₃ },
  try { rw [h_call25_ap_offset] at hl_range_check_ptr₃ }, try { arith_simps at hl_range_check_ptr₃ },
  rw [←htv_range_check_ptr₃, ←htv_range_check_ptr₂] at hl_range_check_ptr₃,
  try { simp only [arg0] at h_call31 },
  try { rw [h_call25_ap_offset] at h_call31 }, try { arith_simps at h_call31 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call31,
  clear arg0,
  -- local var
  step_assert_eq hpc31 with temp0,
  step_assert_eq hpc32 with temp1,
  step_assert_eq hpc33 with temp2,
  have lc_y: y = cast_BigInt3 mem (σ.fp + 3), {
    try { ext } ; {
      try { simp only [htv_y] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2,
  -- function call
  step_assert_eq hpc34 with arg0,
  step_assert_eq hpc35 with arg1,
  step_assert_eq hpc36 with arg2,
  step_assert_eq hpc37 with arg3,
  step_sub hpc38 (auto_sound_validate_reduced_field_element mem _ range_check_ptr₃ y _ _ _ _ _ _),
  { rw hpc39, norm_num2, exact h_mem_10 },
  { rw hpc39, norm_num2, exact h_mem_0 },
  { rw hpc39, norm_num2, exact h_mem_1 },
  { rw hpc39, norm_num2, exact h_mem_2 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call40 ap40 h_call40,
  rcases h_call40 with ⟨rc_m40, rc_mle40, hl_range_check_ptr₄, h_call40⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap40 - 1) = range_check_ptr₄,
  have htv_range_check_ptr₄ := hr_rev_range_check_ptr₄.symm, clear hr_rev_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] at h_call40 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call40,
  clear arg0 arg1 arg2 arg3,
  -- function call
  step_assert_eq hpc40 with arg0,
  step_assert_eq hpc41 with arg1,
  step_assert_eq hpc42 hpc43 with arg2,
  have h_δ40_c0 : ∀ x : F, x / (2 : ℤ) = x * (-1809251394333065606848661391547535052811553607665798349986546028067936010240 : ℤ),
  { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
  have h_δ40_c0_fz : ∀ x : F, x / 2 = x / (2 : ℤ), { intro x, norm_cast },
  step_sub hpc44 (auto_sound_assert_nn mem _ range_check_ptr₄ ((y.d0 + v) / (2 : ℤ)) _ _ _),
  { rw hpc45, norm_num2, exact h_mem_0 },
  { try { simp only [h_δ40_c0_fz, h_δ40_c0] }, try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [h_δ40_c0_fz, h_δ40_c0] }, try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call46 ap46 h_call46,
  rcases h_call46 with ⟨h_call46_ap_offset, h_call46⟩,
  rcases h_call46 with ⟨rc_m46, rc_mle46, hl_range_check_ptr₅, h_call46⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap46 - 1) = range_check_ptr₅,
  have htv_range_check_ptr₅ := hr_rev_range_check_ptr₅.symm, clear hr_rev_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2] at hl_range_check_ptr₅ },
  rw [←htv_range_check_ptr₅, ←htv_range_check_ptr₄] at hl_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2] at h_call46 },
  rw [←htv_range_check_ptr₄, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call46,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc46 with arg0,
  step_assert_eq hpc47 with arg1,
  step_assert_eq hpc48 with arg2,
  step_sub hpc49 (auto_sound_unreduced_sqr mem _ y _ _),
  { rw hpc50, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call51 ap51 h_call51,
  rcases h_call51 with ⟨h_call51_ap_offset, h_call51⟩,
  generalize' hr_rev_y_square: cast_UnreducedBigInt3 mem (ap51 - 3) = y_square,
  simp only [hr_rev_y_square] at h_call51,
  have htv_y_square := hr_rev_y_square.symm, clear hr_rev_y_square,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc51 hpc52 with arg0,
  step_assert_eq hpc53 with arg1,
  step_assert_eq hpc54 with arg2,
  step_assert_eq hpc55 with arg3,
  step_assert_eq hpc56 with arg4,
  step_sub hpc57 (auto_sound_verify_zero mem _ range_check_ptr₅ {
    d0 := x_cube.d0 + BETA - y_square.d0,
    d1 := x_cube.d1 - y_square.d1,
    d2 := x_cube.d2 - y_square.d2
  } _ _ _),
  { rw hpc58, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4)] },
    try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4)] },
      try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call59 ap59 h_call59,
  rcases h_call59 with ⟨h_call59_ap_offset, h_call59⟩,
  rcases h_call59 with ⟨rc_m59, rc_mle59, hl_range_check_ptr₆, h_call59⟩,
  generalize' hr_rev_range_check_ptr₆: mem (ap59 - 1) = range_check_ptr₆,
  have htv_range_check_ptr₆ := hr_rev_range_check_ptr₆.symm, clear hr_rev_range_check_ptr₆,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at hl_range_check_ptr₆ },
  try { rw [h_call51_ap_offset] at hl_range_check_ptr₆ }, try { arith_simps at hl_range_check_ptr₆ },
  rw [←htv_range_check_ptr₆, ←htv_range_check_ptr₅] at hl_range_check_ptr₆,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at h_call59 },
  try { rw [h_call51_ap_offset] at h_call59 }, try { arith_simps at h_call59 },
  rw [←htv_range_check_ptr₅, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call59,
  clear arg0 arg1 arg2 arg3 arg4,
  -- return
  step_assert_eq hpc59 with hret0,
  step_assert_eq hpc60 with hret1,
  step_assert_eq hpc61 with hret2,
  step_assert_eq hpc62 with hret3,
  step_assert_eq hpc63 with hret4,
  step_assert_eq hpc64 with hret5,
  step_ret hpc65,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m6+rc_m17+rc_m31+rc_m40+rc_m46+rc_m59+0+0), split,
  linarith [rc_mle6, rc_mle17, rc_mle31, rc_mle40, rc_mle46, rc_mle59],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5] },
    rw [←htv_range_check_ptr₆, hl_range_check_ptr₆, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_get_point_from_x mem _ range_check_ptr x v _ _,
  { apply sound_get_point_from_x, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_get_point_from_x],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call6],
  use_only [range_check_ptr₁],
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
  have spec6 := h_call6 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec6,
  try { dsimp at spec6, arith_simps at spec6 },
  use_only [spec6],
  use_only [κ_call11],
  use_only [x_square],
  try { dsimp at h_call11, arith_simps at h_call11 },
  try { use_only [h_call11] },
  use_only [κ_call17],
  use_only [range_check_ptr₂],
  use_only [x_square_reduced],
  have rc_h_range_check_ptr₂ := range_checked_offset' rc_h_range_check_ptr₁,
  have rc_h_range_check_ptr₂' := range_checked_add_right rc_h_range_check_ptr₂, try { norm_cast at rc_h_range_check_ptr₂' },
  have spec17 := h_call17 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec17,
  try { dsimp at spec17, arith_simps at spec17 },
  use_only [spec17],
  use_only [κ_call25],
  use_only [x_cube],
  try { dsimp at h_call25, arith_simps at h_call25 },
  try { use_only [h_call25] },
  use_only [κ_call31],
  use_only [range_check_ptr₃],
  use_only [y],
  have rc_h_range_check_ptr₃ := range_checked_offset' rc_h_range_check_ptr₂,
  have rc_h_range_check_ptr₃' := range_checked_add_right rc_h_range_check_ptr₃, try { norm_cast at rc_h_range_check_ptr₃' },
  have spec31 := h_call31 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec31,
  try { dsimp at spec31, arith_simps at spec31 },
  use_only [spec31],
  use_only [κ_call40],
  use_only [range_check_ptr₄],
  have rc_h_range_check_ptr₄ := range_checked_offset' rc_h_range_check_ptr₃,
  have rc_h_range_check_ptr₄' := range_checked_add_right rc_h_range_check_ptr₄, try { norm_cast at rc_h_range_check_ptr₄' },
  have spec40 := h_call40 rc_h_range_check_ptr₃',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←htv_range_check_ptr₄] at spec40,
  try { dsimp at spec40, arith_simps at spec40 },
  use_only [spec40],
  use_only [κ_call46],
  use_only [range_check_ptr₅],
  have rc_h_range_check_ptr₅ := range_checked_offset' rc_h_range_check_ptr₄,
  have rc_h_range_check_ptr₅' := range_checked_add_right rc_h_range_check_ptr₅, try { norm_cast at rc_h_range_check_ptr₅' },
  have spec46 := h_call46 rc_h_range_check_ptr₄',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←htv_range_check_ptr₅] at spec46,
  try { dsimp at spec46, arith_simps at spec46 },
  use_only [spec46],
  use_only [κ_call51],
  use_only [y_square],
  try { dsimp at h_call51, arith_simps at h_call51 },
  try { use_only [h_call51] },
  use_only [κ_call59],
  use_only [range_check_ptr₆],
  have rc_h_range_check_ptr₆ := range_checked_offset' rc_h_range_check_ptr₅,
  have rc_h_range_check_ptr₆' := range_checked_add_right rc_h_range_check_ptr₆, try { norm_cast at rc_h_range_check_ptr₆' },
  have spec59 := h_call59 rc_h_range_check_ptr₅',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←hl_range_check_ptr₅, ←htv_range_check_ptr₆] at spec59,
  try { dsimp at spec59, arith_simps at spec59 },
  use_only [spec59],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, hin_v, htv_range_check_ptr₁, htv_x_square, htv_range_check_ptr₂, htv_x_square_reduced, htv_x_cube, lc_x_cube, htv_range_check_ptr₃, htv_y, lc_y, htv_range_check_ptr₄, htv_range_check_ptr₅, htv_y_square, htv_range_check_ptr₆] }, },
  try { dsimp [cast_BigInt3, cast_UnreducedBigInt3, cast_EcPoint] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5] },
  try { simp only [h_call6_ap_offset, h_call11_ap_offset, h_call17_ap_offset, h_call25_ap_offset, h_call31_ap_offset, h_call46_ap_offset, h_call51_ap_offset, h_call59_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import for_mathlib.derived_functor
import category_theory.abelian.left_derived

universes w v u

noncomputable theory

namespace category_theory.abelian.functor

open category_theory category_theory.functor category_theory.limits
open category_theory.functor.left_derived

variables {C : Type u} {D : Type u} [category.{w} C] [category.{w} D] [enough_projectives C]
variables (F : C ⥤ D) {A₁ A₂ A₃ X : C} {f : A₁ ⟶ A₂} {g : A₂ ⟶ A₃}
variables [abelian C] [abelian D] [additive F] [preserves_finite_colimits F]

section les

def δ₀ (A : short_exact_sequence C) := δ F 0 A ≫ (left_derived_zero_iso_self F).hom.app A.1

lemma seven_term_exact_seq (A : short_exact_sequence C) :
  exact_seq D [
    (F.left_derived 1).map A.f, (F.left_derived 1).map A.g,
    δ₀ F A,
    F.map A.f, F.map A.g, (0 : F.obj A.3 ⟶ F.obj A.3)] :=
begin
  refine exact_seq.cons _ _ (exact_of_short_exact _ _ _) _ (exact_seq.cons _ _ _ _ _),
  { refine preadditive.exact_of_iso_of_exact' ((F.left_derived 1).map A.g) (δ F 0 A) _ _
      (iso.refl _) (iso.refl _) ((left_derived_zero_iso_self F).app A.1) (by simp) _ _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 1 2) } },
  refine exact_seq.cons _ _ _ _ _,
  { refine preadditive.exact_of_iso_of_exact' (δ F 0 A) ((F.left_derived 0).map A.f) _ _
      (iso.refl _) ((left_derived_zero_iso_self F).app A.1) ((left_derived_zero_iso_self F).app A.2)
      _ (by simp) _,
    { dsimp [δ₀], rw [category.id_comp] },
    { exact (exact_iff_exact_seq _ _).2 ((six_term_exact_seq F 0 A).extract 2 2) } },
    apply exact_seq.cons,
    { exact preserves_exact_of_preserves_finite_colimits_of_epi _ A.exact' },
    { rw [← exact_iff_exact_seq],
      exact ((abelian.tfae_epi (F.obj A.3) (F.map A.g)).out 0 2).1
        (category_theory.preserves_epi _ _) }
end

end les

end category_theory.abelian.functor


import LMT

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

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


import LMT

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

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


import lib.tactic
import tactic.rewrite_all

import .data

universe u

meta inductive how
| rewrite (rule_index : ℕ) (location : ℕ) (addr : option (list side))
| defeq
| simp  -- TODO handle "explaining" me
meta def how.to_string : how → format
| (how.rewrite idx loc addr) := format!"rewrite {idx} {loc} {addr.iget.to_string}"
| how.defeq := "(defeq)"
| how.simp := "simp"
meta instance how.has_to_format : has_to_format how := ⟨how.to_string⟩

meta structure rewrite :=
(e   : expr)
(prf : tactic expr) -- we defer constructing the proofs until they are needed
(how : how)

namespace tactic.rewrite_search

structure config :=
(max_iterations  : ℕ := 500)
(max_discovers   : ℕ := 0)
(optimal         : bool := tt)
(exhaustive      : bool := ff)
(trace           : bool := ff)
(trace_summary   : bool := ff)
(trace_rules     : bool := ff)
(trace_discovery : bool := tt)
(explain         : bool := ff)
(explain_using_conv : bool := tt)

end tactic.rewrite_search

open tactic

namespace rw_equation

meta def split : expr → tactic (expr × expr)
| `(%%lhs = %%rhs) := return (lhs, rhs)
| `(%%lhs ↔ %%rhs) := return (lhs, rhs)
| _                := fail "target is not an equation or iff"

meta def lhs (e : expr) : tactic expr := prod.fst <$> split e

meta def rhs (e : expr) : tactic expr := prod.snd <$> split e

end rw_equation

meta def is_acceptable_rewrite (t : expr) : bool :=
t.is_eq_or_iff_after_binders

meta def is_acceptable_lemma (r : expr) : tactic bool :=
  is_acceptable_rewrite <$> (infer_type r >>= whnf)

meta def is_acceptable_hyp (r : expr) : tactic bool :=
  do t ← infer_type r >>= whnf, return $ is_acceptable_rewrite t ∧ ¬t.has_meta_var


import data.real.basic

theorem exo:
  (forall (a b c: real), ((2*a + b + c)^2)/(2*a^2 + (b + c)^2) + ((2*b + c + a)^2)/(2*b^2 + (c + a)^2) + ((2*c + a + b)^2)/(2*c^2 + (a + b)^2) <= 8)
:=
  sorry


import LMT

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

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


import LMT

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

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


import LMT

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

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


import LMT

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

example {a1 a2 a3 : A I E} :
        (v3) ≠ ((((a1).write i3 (v3)).write i1 (v3)).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} :
        (v1) ≠ ((((a2).write i1 (v1)).write i3 (v1)).read i1) → False := by
  arr


import LMT

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

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


import feather_model.basic

open_locale classical

open feather_model

@[reducible] def 𝕋 := mterm (finset V)

/-- To establish a base case for the model, we create the "empty" model level. -/
instance : term_struct (finset V) := {
  var := λ v, {v},
  bound := id,
  subst := λ v e f, if v ∈ f then f.erase v ∪ e else f,
  is_type := λ _ _, true,
  runtime_ok := λ _, true,
  rir_ok := λ _, true,
  runtime_judgments := λ _, true,
  rir_judgments := λ _, true,
  defeq := λ _ _ _ _, true,
  sort := λ _, ∅,
  representable := λ s f, f,
}

instance : type_data (finset V) := ⟨λ _ _, true, λ _, true⟩

instance : term (finset V) :=
begin
  refine_struct { .. };
  intros; try { trivial },
  { unfold subst,
    rw if_neg,
    assumption, },
  { unfold subst,
    rw if_pos,
    refl,
    assumption, },
end

example : term_struct 𝕋 := infer_instance


import LMT

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

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


import LMT

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

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