import metaphysics.metaphysics states
open set topological_space classical
set_option pp.generalized_field_notation true
local attribute [instance] prop_decidable

namespace ontology

variable {ω : ontology}

section theism

  variable (ω)

  /-- **Theism** is the doctrine that the necessary being is simple. -/
  def theism := ω.nb.simple
  /-- Negation of `theism`. -/
  @[reducible, simp]
  def atheism := ¬ ω.theism

  /-- **Classical Theism** is an extension of theism which
      furthermore claims that there is a possible world
      in which the necessary being exists alone. -/
  def ctheism := ∃ (w : ω.world), ∀ e₁ e₂ : ω.entity, e₁.exists w → e₂.exists w → e₁ = e₂

  /-- this is a not so trivial proof that if the nb exists alone,
      then it has no accidents, because accidents are contingent. -/
  @[simp] lemma theism_of_ctheism {ω : ontology} : ω.ctheism → ω.theism :=
    begin
      rintros ⟨w, hw⟩,
      dunfold theism,
      by_contradiction h,
      replace h : ω.nb.composite,
        simp at h, simp [h],
      replace h := nb_acc_actual h w,
      obtain ⟨a, ha₁, ha₂⟩ := h,
      have ha₃ := a.contingent,
      simp at ha₃,
      specialize hw a ω.nb ha₂ (by simp [nb, nbe]),
      unfold_coes at hw,
      simp [nb] at hw,
      contradiction,
    end

  /-- **Greek Theism** is non-classical theism. -/
  def greek_theism := ω.theism ∧ ¬ ω.ctheism

  -- All 4 positions are logically consistent:

  -- lemma atheism_consistent : ∃ ω : ontology, ω.atheism := sorry
  -- lemma theism_consistent : ∃ ω : ontology, ω.theism := sorry
  -- lemma ctheism_consistent : ∃ ω : ontology, ω.ctheism := sorry
  -- lemma greek_theism_consistent : ∃ ω : ontology, ω.greek_theism := sorry

  -- It is actually considerably annoying to formally prove the previous results even though they are absolutely trivial,
  -- so we leave them commented out. But consider that, given our lemma `nb_simple_iff_space_connected`
  -- in substances.lean, any connected space is a model of theism, and any disconnected space a model of atheism.
  -- Any connected space without a focal point is a model of greek theism (e.g. a sphere), and a
  -- space is a model of classical theism if and only if it has a focal point. Every partial order with a least
  -- element is a model of classical theism when given its Alexandroff topology.

  /-- The *second gap problem* is showing that God satisfies
      the properties prescribed to Him by classical theism
      under the assumption that God exists.
      This is not to be confused with the *first gap problem*
      of showing that if the necessary being is a first cause of all
      things in some possible world, then it is God.
      An ontology `ω` is said to contain **no second gap**
      if this gap problem admits a solution in `ω`.
      Solutions of the gap problem are proofs of the
      `ω.nogap₂` proposition, and may be also called **(secondary) gap fillers**. -/
  def nogap₂ : Prop := ω.theism → ω.ctheism

  -- WORK IN PROGRESS (RELATED TO 4TH WAY).
  -- theorem qparticipated_of_theism : ω.theism → (∀ b : ω.being, b.qparticipated) := sorry

  theorem theism_iff_connected : ω.theism ↔ ω.connected := nb_simple_iff_space_connected

end theism

section divine_properties

  -- First we discuss pure actuality:
  variables (s : ω.substance) (e : ω.entity)

  /-- A substance is **Purely Actual** if it has no passive potentiality
      to be different from what it is, i.e. if it has a single state. -/
  def substance.purely_actual := ∀ w₁ w₂ : ω.world, s.state w₁ = s.state w₂

  /-- Only the necessary being can be purely actual,
      in which case theism follows. -/
  theorem substance.eq_nb_of_purely_actual : s.purely_actual → s.necessary :=
  begin
      intros h,
      simp [substance.purely_actual] at h,
      ext w₁,
      simp [nb, nbe],
      obtain ⟨w₂, hw₂⟩ := s.possible,
      specialize h w₁ w₂,
      replace hw₂ := exists_iff_in_state.mp hw₂,
      rw ←h at hw₂,
      exact exists_iff_in_state.2 hw₂,
  end

  theorem substance.simple_of_purely_actual : s.purely_actual → s.simple :=
    begin
      intro h₀,
      by_contradiction h,
      simp [set.nonempty, accident.inheres] at h,
      obtain ⟨a, ha⟩ := h,
      obtain ⟨w₁, hw₁⟩ := a.possible,
      have h := a.contingent,
      simp [nb, nbe, ext_iff] at h,
      obtain ⟨w₂, hw₂⟩ := h,
      specialize h₀ w₁ w₂,
      simp [substance.state, ext_iff] at h₀,
      specialize h₀ a,
      unfold_coes at h₀,
      simp [ha, hw₁, hw₂] at h₀,
      contradiction,
    end

  theorem theism_iff_purely_actual : ω.theism ↔ ∃ s : ω.substance, s.purely_actual :=
    begin
      constructor; intro h,
        use ω.nb,
        intros w₁ w₂,
        transitivity ({ω.nbe} : set  ω.entity);
        simp [substance.state, ext_iff];
        intro x;
        by_cases hyp : x = ω.nbe,
          any_goals {rw hyp,
          simp [nb], constructor,
            apply self_subsist.mp,
            simp [entity.perfect, nbe],
          },
          any_goals {simp [entity.perfect, nbe]},
        any_goals {simp [nb]},
        any_goals {
        have : ¬ x.subsists ω.nbe,
          intro h₀,
          simp [theism, set.nonempty] at h,
          have := imperfect_of_subsists_other h₀ hyp,
          let x' : ω.accident := ⟨x, this⟩,
          apply h x',
          simpa [x', accident.inheres, nb],
          simp [this],
          simp [nbe, ext_iff] at hyp,
          exact hyp,
        },
      obtain ⟨g, hg⟩ := h,
      have c₀ := g.eq_nb_of_purely_actual hg,
      simp [substance.necessary] at c₀,
      replace hg := g.simple_of_purely_actual hg,
      simp only [theism],
      rwa ←c₀ at *,
    end

  -- Then we discuss causal properties which properly belong to the divine being:
  variable (c : ω.cause)

  /-- A a causal structure `c` is **principled** (in the sense that it emanates from
      a necessary first principle) just in case the necessary being can possibly be a `first_cause`
      with respect to `c`. Proofs that a causal structure is principled are called
      **(stage 1) cosmological arguments**. -/
  @[reducible, simp, alias]
  def cause.principled : Prop := c.dscotus

  /-- The *first gap problem* is showing that if
      the necessary being is a first cause of all
      things in some possible world, then it is God.
      A causal structure `c` is said to contain **no first gap**
      if this gap problem admits a solution with respect to `c`.
      Solutions of the gap problem are proofs of the
      `c.nogap₂` proposition, and may be called **(primary) gap fillers**
      or **(stage 2) cosmological arguments**. -/
  def cause.nogap₁ : Prop := c.principled → ω.theism

  /-- The *conjoined gap problem* is showing that if
      the necessary being is a first cause of all
      things in some possible world, then it is **the classical theistic** God.
      A causal structure `c` is said to contain **no gap**
      if this gap problem admits a solution with respect to `c`.
      Solutions of the gap problem are proofs of the
      `c.nogap₁₂` proposition, and may be called **(both primary and secondary) gap fillers**
      or **(stage 2) cosmological arguments**. -/
  def cause.nogap₁₂ : Prop := c.principled → ω.ctheism

end divine_properties

/-- A **Theos** is a conception of God compatible with `greek_theism`.
    It is God from the point of view of classical pagan theology. -/
structure theos (ω : ontology) :=
  (s : ω.substance)
  (necessary : s.necessary)
  (simple : s.simple)

/-- A **God** is a **Theos** with the attribute of **Divine Aseity**.
    Assumption of aseity is sufficient for proving all the properties
    of the classical theistic God.
    God is here taken as a synonym for "Deus",
    or "the classical latin, or scholastic, conception of God". -/
structure god (ω : ontology) extends theos ω :=
  (aseity : ∃ w : ω.world, ∀ s' ∈ w.substances, s' = s)

@[reducible, simp]
def god.up (g : ω.god) := g.to_theos

section theos

  variable (g : ω.theos)

  @[simp]
  theorem theos_iff_theism : nonempty ω.theos ↔ ω.theism :=
    begin
      refine ⟨λne,_, λh,⟨⟨ω.nb, rfl, h⟩⟩⟩,
      obtain ⟨g⟩ := ne,
      simp [theism, -substance.simple],
      have c := g.necessary, simp [substance.necessary] at c,
      rw ←c, exact g.simple,
    end

  def theos.theism := theos_iff_theism.mp ⟨g⟩

  /-- God is a purely actual substance. -/
  lemma theos.purely_actual : g.s.purely_actual :=
    begin
      have c := g.theism,
      replace c := theism_iff_purely_actual.mp c,
      obtain ⟨s, hs⟩ := c,
      have c := g.necessary,
      simp [substance.necessary] at c, rw c, clear c,
      have c := s.eq_nb_of_purely_actual hs,
      simp [substance.necessary] at c,
      rwa ←c,
    end

  theorem monotheism : ∀ g g' : ω.theos, g = g' :=
    begin
      intros g g',
      casesm* ω.theos, simp,
      simp [substance.necessary] at *,
      rw g_necessary,
      rw g'_necessary,
    end

  -- WORK IN PROGRESS (RELATED TO 4TH WAY).
  -- /-- God is a fixed point of any possessed property He may possibly exemplify.
  --     As such we say that He is his Omnipotence, His Omniscience, His benevolence,
  --     and whatever else is predicated of Him, *in the precise and non-paradoxical sense*
  --     that the *event* of God being (e.g.) Omnipotent is the *event* of God existing,
  --     and also the *event* of Him being Omniscient, etc...
  --     This would actually be valid for any simple substance as well.
  --     -/
  -- theorem divine_simplicity : ∀ p : ω.predicate, p.possessed → ⋄p g.s → p g.s = g.s.exists := sorry

  -- WORK IN PROGRESS (RELATED TO 4TH WAY).
  -- /-- God is maximally perfect w.r.t. any analogy of being. -/
  -- theorem theos.maximally_perfect : ∀ (g : ω.theos) (b : ω.being), g.s.up.mperfect b.is := sorry

end theos

section god

  variable (g : ω.god)

  @[simp]
  theorem god_iff_ctheism : nonempty ω.god ↔ ω.ctheism :=
    begin
      refine ⟨λh,_, λh,⟨⟨⟨ω.nb, rfl, _,⟩,_⟩⟩⟩,
        obtain ⟨g⟩ := h,
        obtain ⟨w, hw⟩ := g.aseity,
        use w, intros e₁ e₂ h₁ h₂,
        have c₀ : ∀ e : ω.entity, e.exists w → e.perfect,
          intros e he,
          by_contradiction c₀,
          let a : ω.accident := ⟨e, c₀⟩,
          specialize hw a.owner,
          simp [world.substances] at hw,
          specialize hw _, swap,
            exact entails_of_inheres a.inh_owner he,
          have c₁ := a.inh_owner, rw hw at c₁,
          have c₂ := g.simple, simp [substance.simple, set.nonempty] at c₂,
          specialize c₂ a,
          contradiction,
        have c₁ := c₀ e₁ h₁,
        have c₂ := c₀ e₂ h₂,
        clear c₀,
        let s₁ : ω.substance := ⟨e₁, c₁⟩,
        let s₂ : ω.substance := ⟨e₂, c₂⟩,
        simp [world.substances] at *,
        have c₃ := hw s₁ h₁, simp [s₁] at c₃,
        have c₄ := hw s₂ h₂, simp [s₂] at c₄,
        rw ← c₄ at c₃, simp at c₃,
        exact c₃,
      by_contradiction c,
      simp [substance.simple, ext_iff] at c,
      obtain ⟨a, ha⟩ := c,
      obtain ⟨w, hw⟩ := h,
      let a' := a.localize w,
      specialize hw a' ω.nbe (a.localize_exists _) (by simp [nbe]), swap,
        rw (unique_inheres a.inh_owner ha),
        simp [nb, nbe],
      unfold_coes at hw,
      simp [-entity_ext_iff] at hw,
      have c₁ := a'.imperfect,
      have c₂ := ω.nb.perfect, simp [nb, -self_subsist] at c₂,
      rw hw at c₁,
      contradiction,
        obtain ⟨w, hw⟩ := h,
        use w,
        intros s hs, simp,
        simp [world.substances] at hs,
        specialize hw s.up ω.nbe hs (by simp [nbe]),
        simp at hw,
        apply substance_ext,
        exact hw,
    end

  def god.ctheism := god_iff_ctheism.mp ⟨g⟩

  theorem uniqueness_of_god : ∀ g g' : ω.god, g = g' :=
    by intros g g'; casesm* ω.god; simp; apply monotheism

  /-- God is a purely actual substance. -/
  lemma god.purely_actual : g.s.purely_actual := g.up.purely_actual

  -- WORK IN PROGRESS (RELATED TO 4TH WAY).
  -- /-- God is maximally perfect w.r.t. any analogy of being. -/
  -- theorem god.maximally_perfect : ∀ (g : ω.god) (b : ω.being), g.s.up.mperfect b.is := sorry

  lemma weakly_parmenidean_iff₄ : ω.weakly_parmenidean ↔ ω.ctheism :=
    begin
      simp [weakly_parmenidean, ctheism, set.nonempty, parmenidean],
      constructor; rintros ⟨w, hw⟩; use w; intros,
        transitivity ω.nbe.exists, apply hw, assumption,
        symmetry, apply hw, assumption,
      apply hw, assumption,
      simp [nbe, ext_iff],
    end

  /-- God is absolutely real. -/
  theorem god.absolutely_real : g.s.up.absolutely_real :=
    begin
      convert weakly_parmenidean_iff₃.mp _,
        have := g.necessary,
        cases g.to_theos.s,
        simp [substance.necessary, nb] at this,
        simpa,
      apply weakly_parmenidean_iff₄.2,
      exact g.ctheism,
    end

  theorem ctheism_of_no_universe : (¬∃ e : ω.entity, e.contingent) → ω.ctheism :=
    begin
      intro h,
      push_neg at h,
      obtain ⟨w⟩ := ω.wne,
      use w,
      intros e₁ e₂ h₁ h₂, clear h₁ h₂,
      rw h e₁,
      rw h e₂,
    end

  theorem ctheism_of_no_universe₂ : ∀ {w}, (¬∃ e : ω.entity, e.contingent ∧ e.exists w) → ω.ctheism :=
    begin
      intros w h,
      push_neg at h,
      use w,
      intros e₁ e₂ h₁ h₂,
      have c₁ := h e₁,
      have c₂ := h e₂,
      simp [h₁,h₂] at *, clear h h₁ h₂,
      rw c₁, rw c₂,
    end

  /-- If there are contingent substances, `ω.ctheism` is true
      if and only if the universe is contingent, otherwise
      there is no universe (of contingent things) and in this case also
      `ω.ctheism` is true.
      -/
  theorem ctheism_iff_universe_contingent : (Sup $ @entity.contingent ω).contingent ∨ (¬∃ e : ω.entity, e.contingent) ↔ ω.ctheism :=
    begin
      by_cases c : (set.nonempty $ @entity.contingent ω);
      simp [Sup, c],
      swap,
      have c' := ctheism_of_no_universe c,
      simp [c'],
      simp [set.nonempty, has_mem.mem, set.mem] at c,
      right, exact c,
        constructor; intro h,
          cases h,
            simp [has_Sup.Sup, c, entity_Sup, ext_iff] at h,
            obtain ⟨w, hw⟩ := h,
            simp [nbe] at hw,
            use w, intros e₁ e₂ h₁ h₂,
            have c₁ := hw e₁,
            replace c₁ : e₁ = ω.nbe,
              finish [has_mem.mem, set.mem, h₁],
            have c₂ := hw e₂,
            replace c₂ : e₂ = ω.nbe,
              finish [has_mem.mem, set.mem, h₂],
            rw c₁, rw c₂,
          refine ctheism_of_no_universe _,
          push_neg,
          intro e,
          apply entity_ext,
          exact h e,
        left,
        simp [has_Sup.Sup, c, entity_Sup, nbe, ext_iff],
        obtain ⟨w, hw⟩ := h,
        use w, intros e he insanity,
        simp [has_mem.mem, set.mem, -entity_ext_iff] at he,
        specialize hw e ω.nbe insanity (by simp [nbe]),
        contradiction,
    end

  -- THIS SECTION IS A WORK IN PROGRESS.
  section power_and_will

    variables (c : ω.cause) (e : ω.entity)

    -- TODO: causal structures in this section will probably need to be constrained by
    -- some plausible assumptions in order to make the following theorems true.
    -- Figure out which assumptions before doing the proofs.

    -- theorem god.omnipotent : c.omnipotent g.s.up := sorry
    -- theorem to_be_is_to_be_caused_by_god : c.causes g.s e = e := sorry
    -- theorem creation_preceeds_matter : ¬∃ context : ω.event, c.causes g.s e ⇒ context ∧
    --                                     c.causes g.s e ≠ context ∧ ¬□context := sorry
    -- theorem god.free : c.is_free g.s := sorry

  end power_and_will

end god

section atheism

  /-- Atheism is committed to the existence of complemented entities. -/
  theorem atheism_positive_commitments : ω.atheism ↔ ∃ e : ω.entity, e.complemented :=
    begin
      simp [atheism, theism, set.nonempty],
      constructor; rintro ⟨a, ha⟩,
        have := compl_iff_inheres_nb.mp ha,
        exact ⟨a, this⟩,
      have : a.imperfect,
        have c := closure_eq_of_is_closed ha.2.2,
        replace ha := ha.1,
        simp [entity.contingent, nbe] at ha,
        simp [entity.imperfect, entity.perfect],
        rwa c,
      use ⟨a, this⟩,
      apply compl_iff_inheres_nb.2 _,
      assumption,
    end

  lemma atheism_has_universe : ω.atheism → ∃ e : ω.entity, e.contingent :=
    by contrapose; intro h; simp; exact theism_of_ctheism (ctheism_of_no_universe h)

  lemma eq_nbe_Sup_of_atheism : ω.atheism → ω.nbe = Sup entity.contingent :=
    begin
      intro h,
      have c := (@ctheism_iff_universe_contingent ω).mp,
      replace c := λh₀, theism_of_ctheism (c h₀),
      replace c : ¬(Sup entity.contingent).contingent, finish,
      simp [-entity_ext_iff] at c,
      symmetry,
      exact c,
    end

end atheism

end ontology


import Mathlib.Tactic.GuardGoalNums

example : true ∧ true := by
  constructor
  guard_goal_nums 2
  all_goals {constructor}

example : (true ∧ true) ∧ (true ∧ true) := by
  constructor <;> constructor
  guard_goal_nums 4
  all_goals {constructor}


/-
File: signature_recover_public_key_ec_negate_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_verify_zero_soundness
import .signature_recover_public_key_nondet_bigint3_soundness
open tactic

open starkware.cairo.common.cairo_secp.ec
open starkware.cairo.common.cairo_secp.bigint
open starkware.cairo.common.cairo_secp.field

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

/- starkware.cairo.common.cairo_secp.ec.ec_negate autogenerated soundness theorem -/

theorem auto_sound_ec_negate
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_negate σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 160))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 112))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_point : point = cast_EcPoint mem (σ.fp - 8))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      τ.ap = σ.ap + 34 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 7)
        (spec_ec_negate mem κ range_check_ptr point (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_ec_negate at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15⟩,
  -- function call
  step_assert_eq hpc0 with arg0,
  step_sub hpc1 (auto_sound_nondet_bigint3 mem _ range_check_ptr _ _),
  { rw hpc2, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call3 ap3 h_call3,
  rcases h_call3 with ⟨h_call3_ap_offset, h_call3⟩,
  rcases h_call3 with ⟨rc_m3, rc_mle3, hl_range_check_ptr₁, h_call3⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap3 - 4) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_minus_y: cast_BigInt3 mem (ap3 - 3) = minus_y,
  simp only [hr_rev_minus_y] at h_call3,
  have htv_minus_y := hr_rev_minus_y.symm, clear hr_rev_minus_y,
  try { simp only [arg0] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0] at h_call3 },
  rw [hin_range_check_ptr] at h_call3,
  clear arg0,
  -- function call
  step_assert_eq hpc3 with arg0,
  step_assert_eq hpc4 with arg1,
  step_assert_eq hpc5 with arg2,
  step_assert_eq hpc6 with arg3,
  step_sub hpc7 (auto_sound_verify_zero mem _ range_check_ptr₁ {
    d0 := minus_y.d0 + point.y.d0,
    d1 := minus_y.d1 + point.y.d1,
    d2 := minus_y.d2 + point.y.d2
  } _ _ _),
  { rw hpc8, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_minus_y] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
    try { simp only [h_call3_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_point, htv_range_check_ptr₁, htv_minus_y] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      try { simp only [h_call3_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call9 ap9 h_call9,
  rcases h_call9 with ⟨h_call9_ap_offset, h_call9⟩,
  rcases h_call9 with ⟨rc_m9, rc_mle9, hl_range_check_ptr₂, h_call9⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap9 - 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_call9 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call9,
  clear arg0 arg1 arg2 arg3,
  -- return
  step_assert_eq hpc9 with hret0,
  step_assert_eq hpc10 with hret1,
  step_assert_eq hpc11 with hret2,
  step_assert_eq hpc12 with hret3,
  step_assert_eq hpc13 with hret4,
  step_assert_eq hpc14 with hret5,
  step_ret hpc15,
  -- finish
  step_done, use_only [rfl, rfl],
  split,
  { try { simp only [h_call3_ap_offset ,h_call9_ap_offset] },
    try { arith_simps }, try { refl } },
  -- range check condition
  use_only (rc_m3+rc_m9+0+0), split,
  linarith [rc_mle3, rc_mle9],
  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₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_ec_negate mem _ range_check_ptr point _ _,
  { apply sound_ec_negate, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_ec_negate],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call3],
  use_only [range_check_ptr₁],
  use_only [minus_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 spec3 := h_call3 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec3,
  try { dsimp at spec3, arith_simps at spec3 },
  use_only [spec3],
  use_only [κ_call9],
  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 spec9 := h_call9 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec9,
  try { dsimp at spec9, arith_simps at spec9 },
  use_only [spec9],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_minus_y, htv_range_check_ptr₂] }, },
  try { dsimp [cast_EcPoint, cast_BigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5] },
  try { simp only [h_call3_ap_offset, h_call9_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import data.list
import data.pfun

/-! A simple parser combinator library
    Similar to http://dev.stephendiehl.com/fun/002_parsers.html
-/

universes u v

structure Parser (a : Type u) :=
  mk :: (parse : string -> list (a × string))

def runParser {a} (m : Parser a) (s : string) : a ⊕ string :=
match m.parse s with
| [(res, "")] := sum.inl res
| [(_, rs)] := sum.inr "Parser did not consume entire stream."
| [] := sum.inr "No matches."
| _ := sum.inr "Ambiguous."
end

instance parser_has_pure : has_pure Parser :=
  { pure := λ α a, Parser.mk (λ s, [(a, s)]) }

instance parser_has_bind : has_bind Parser :=
  { bind := λ α β p f, Parser.mk (λ s, (p.parse s) >>= λ ⟨a, s'⟩, (f a).parse s') }

instance parser_functor : functor Parser :=
  { map := λ α β f p, p >>= (pure ∘ f) }

instance parser_has_seq : has_seq Parser :=
  { seq := λ α β p q, p >>= λ f, f <$> q }

instance parser_applicative : applicative Parser := {}
instance parser_monad : monad Parser := {}

def mplus {a} (p : Parser a) (q : Parser a) : Parser a :=
  Parser.mk $ λ s, p.parse s ++ q.parse s

instance parser_has_orelse : has_orelse Parser :=
  { orelse := λ _ p q,
      Parser.mk $ λ s, match p.parse s with
        | [] := q.parse s
        | res := res
        end }

instance parser_alternative : alternative Parser :=
  { failure := λ _, Parser.mk $ λ _, [] }

/-- Some higher order parsers like many, many1, .. only terminate
    for some argument parsers. Therefore we factor the termination
    out into a type class. -/
def parser_rel {a} (p : Parser a) : string -> string -> Prop :=
  λ s1 s2, s1 ∈ (λ x : (a × string), x.2) <$> (p.parse s2)

class productive {a} (p : Parser a) :=
  (produces : well_founded (parser_rel p))

def list_bind_contains {a b} : Π (ls : list a) (f : Π x, x ∈ ls -> list b), list b
| [] f := []
| (l::ls) f := f l (by simp) ++ list_bind_contains ls (λ x h, f x (by simp [h]))

--  (::) <$> v <*> (many1 v <|> pure [])
def many1_rec {a} (v : Parser a)
  : Π s, (Π y, parser_rel v y s -> list (list a × string)) -> list (list a × string) :=
  λ s, λ rec, list_bind_contains (v.parse s) $ λ ⟨a', s'⟩ h,
    let h2 : parser_rel v s' s := by { simp [parser_rel], exact ⟨a', h⟩, }
    in match (rec s' h2) with
    | [] := [⟨[a'], s'⟩]
    | res := (λ x : (list a × string), ⟨a' :: x.1, x.2⟩) <$> res
    end

def many1 {a} (v : Parser a) [d : productive v] : Parser (list a) :=
  Parser.mk $ λ s, @well_founded.fix _ _ _ d.produces (many1_rec v) s

def many {a} (v : Parser a) [productive v] : Parser (list a) :=
  many1 v <|> pure []

def item : Parser char :=
  Parser.mk $ λ s, match string.to_list s with
    | [] := []
    | (c::cs) := [(c, list.as_string cs)]
    end

lemma list_string_id {x} : list.as_string (string.to_list x) = x :=
begin
  cases x, rw [string.to_list, list.as_string],
end

lemma string_list_id {x} : string.to_list (list.as_string x) = x :=
begin
  cases x, repeat { simp [list.as_string, string.to_list], },
end

lemma item_productive_acc : ∀ l, acc (parser_rel item) (list.as_string l)
| [] := acc.intro _ (λ y h,
  begin
    simp [parser_rel, item, (<$>), string_list_id] at h,
    from false.elim h
  end)
| (l::ls) := acc.intro _ (λ y h,
  begin
    simp [parser_rel, item, string_list_id, (<$>)] at h,
    let h2 := item_productive_acc ls,
    rwa [h.symm] at h2,
  end)

instance item_productive : productive item :=
  { produces :=
    begin
      apply well_founded.intro, intro s,
      from eq.mp (by simp [list_string_id]) (item_productive_acc (string.to_list s))
    end }

def transform {a} (p : char -> option a) : Parser a :=
  item >>= λ c, match p c with
    | some r := pure r
    | none := Parser.mk (λ _, [])
    end

lemma transform_productive_acc {a f}
  : ∀ l, acc (parser_rel (@transform a f)) (list.as_string l)
| [] := acc.intro _ (λ y h,
  begin
    simp [parser_rel, transform, (>>=), item, string_list_id, (<$>)] at h,
    from false.elim h
  end)
| (l::ls) := acc.intro _ (λ y h,
  begin
    simp [parser_rel, transform, (>>=), item, string_list_id, parser_has_bind] at h,
    cases f l, { simp [transform] at h, from false.elim h },
    simp [transform, pure] at h,
    let h2 := transform_productive_acc ls,
    rwa [h.symm] at h2,
  end)

instance transform_productive {a f} : productive (@transform a f) :=
  { produces :=
    begin
      apply well_founded.intro, intro s,
      from eq.mp (by simp [list_string_id]) (transform_productive_acc (string.to_list s))
    end }

def satisfy (p : char -> bool) : Parser char :=
  transform (λ c, if p c then some c else none)

instance satisfy_productive {f} : productive (satisfy f) :=
  { produces := begin simp [satisfy], from transform_productive.produces, end }

def oneOf (ls : list char) : Parser char := satisfy (λ c, c ∈ ls)

instance oneOf_productive {ls} : productive (oneOf ls) :=
  { produces := begin simp [oneOf], from satisfy_productive.produces, end }

def spaces : Parser (list char) := many (oneOf [' ', '\t', '\n'])

/-- The 'char' parser. -/
def character (c : char) : Parser char := satisfy (λ d, c = d)

def asDigit : char -> option nat
| '0' := some 0 | '1' := some 1 | '2' := some 2 | '3' := some 3 | '4' := some 4
| '5' := some 5 | '6' := some 6 | '7' := some 7 | '8' := some 8 | '9' := some 9
| _ := none

def isDigit (c : char) : bool := option.is_some (asDigit c)

def digit : Parser char := satisfy isDigit

def token {a} (p : Parser a) : Parser a :=
  p >>= λ a, spaces >> pure a

/-- The 'string' parser. -/
def charlist : list char -> Parser (list char)
| [] := pure []
| (c::cs) := character c >> charlist cs >> pure (c :: cs)

def reserved (s : string) : Parser string :=
  token (charlist (string.to_list s)) >> pure s

def parens {a} (p : Parser a) : Parser a :=
  reserved "(" >> p >>= λ r, reserved ")" >> pure r

def combineNum : Π (ls : list nat), nat
| [] := 0
| (l::ls) := l * (10 ^ ls.length) + combineNum ls

def natural : Parser nat :=
   combineNum <$> many1 (transform asDigit)

def integer : Parser int :=
  (character '-' <|> pure '+') >>= λ c,
  (λ n : nat, if c = '-' then -n else n) <$> natural

-- chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
-- chainl p op a = (p `chainl1` op) <|> return a

-- chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
-- p `chainl1` op = do {a <- p; rest a}
  -- where rest a = (do f <- op
                     -- b <- p
                     -- rest (f a b))
                 -- <|> return a


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .zfc
open fol
open zfc

local infix `∈'`:100 := bounded_formula_of_relation ZFC_el
local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`:0) := l

def L_ZFC_structure_of_Set : Structure L_ZFC :=
begin
  refine ⟨Set,_,_⟩,
  {intros n f, repeat{cases f}},
  {intros n r v, cases r, cases v, cases v_xs, exact v_x ∈ v_xs_x}
end

local notation `Set'` := L_ZFC_structure_of_Set

instance has_mem_Set'_Set' : (has_mem Set' Set') := ⟨Set.mem⟩

instance has_mem_Set_Set' : has_mem Set.{0} Set' := ⟨Set.mem⟩

instance has_emptyc_Set' : has_emptyc Set' := ⟨Set.empty⟩

lemma  empty_subset : ∀ x: Set',  Set.empty ⊆ x := by tidy

lemma Set'_Set : ↥Set' = Set := by refl

@[simp]lemma Set'_Set_2 {p : (by exact ↥Set') → Prop} : (λ x, p x) = λ x : Set, p x := by refl

lemma Set'_has_mem : has_mem ↥Set' ↥Set' := ⟨ Set.mem ⟩
local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

example : Set' ⊨ (∃' is_emptyset) :=
begin
  unfold is_emptyset, simp[realize_sentence_ex], refine ⟨∅, _⟩, tidy
end

@[simp]lemma Set'_rel_mem {x y : Set} :  (Structure.rel_map Set' ZFC_rel.ϵ ( [x,y] ) ) = (x ∈ y) := by tidy

@[simp] lemma Set'_mem_mem {n : ℕ} {x y : bounded_term L_ZFC n} {v : dvector ↥Set' n} : realize_bounded_formula v (x ∈' y) dvector.nil = ((realize_bounded_term v x dvector.nil) ∈ (realize_bounded_term v y dvector.nil)) := begin
  simp [ZFC_el, bounded_formula_of_relation, realize_bounded_formula, bd_apps_rel] end

@[simp] lemma realize_term_remove_irrel {n : ℕ} {L : Language} {S : Structure L} {v : dvector ↥S (n+1)} {j : fin n} {k : ℕ} {p : k > j} : realize_bounded_term v ((lift_bounded_term_at (bd_var j : bounded_term L n) 1 k) ) dvector.nil = realize_bounded_term (dvector.remove_mth k v)  (bd_var j) dvector.nil :=
begin
sorry
end

set_option trace.check true

@[simp]lemma Set'_realize_subset_2 : ∀ x y : Set, @realize_bounded_formula L_ZFC Set' 2 0 (x :: y :: dvector.nil) subset  dvector.nil  = Set.subset x y:=
begin
  simp only [subset, Set'_mem_mem, fol.realize_bounded_formula, fol.realize_bounded_term, dvector.nth],
  intros, conv {to_lhs, change ∀ z, z ∈ x → z ∈ y}, rw [Set.subset]
end
set_option trace.app_builder true

@[simp]lemma Set'_realize_is_empty : ∀ x, (@realize_bounded_formula L_ZFC Set' _ _ ([x]) is_emptyset dvector.nil ↔ x = ∅) :=
begin
  intro x, unfold is_emptyset,
   simp only [not_exists, fol.realize_bounded_formula_ex, Set'_mem_mem,
   fol.realize_bounded_formula, fol.realize_bounded_formula_not, fol.realize_bounded_term],
   symmetry, apply Set.eq_empty
end

@[simp]lemma Set'_realize_empty : @realize_bounded_formula L_ZFC Set' 1 0 (Set.empty :: dvector.nil) is_emptyset dvector.nil :=
by rw[Set'_realize_is_empty]; refl

-- set_option trace.simplify.rewrite true

lemma Set'_models_extensionality : axiom_of_extensionality ∈ Th Set' :=
begin
  simp [Th, axiom_of_extensionality, fin.val, has_one.one, fin.of_nat],
  intros x y, intro h, apply Set.ext, intro z, revert h,  intro h, have := h z, exact this
end

lemma Set'_models_union : axiom_of_union ∈ Th Set' :=
begin
  simp only [Th, axiom_of_union, small], intro x,
  conv {congr, skip, congr, congr, congr, skip,
       change (∃' (&1 ∈' &0 ⊓ &0 ∈' &3) : bounded_formula L_ZFC 3)},
  simp, change ∃ U, ∀ z, z ∈ U ↔ ∃ w, z ∈ w ∧ w ∈ x,
  refine ⟨⋃ x, _⟩, intro z, rw[@Set.mem_Union x z], finish
end

lemma Set'_models_powerset : axiom_of_powerset ∈ Th Set' :=
begin
  simp only [Th, axiom_of_powerset, small,  fol.realize_bounded_formula_ex,
 fol.realize_bounded_formula, realize_bounded_formula_biimp, set.mem_set_of_eq],
  intros,
  refine ⟨Set.powerset x, _⟩,
  intro y, change y ∈ Set.powerset x ↔ Set.subset y x,
  exact Set.mem_powerset,
end

lemma Set'_models_choice : axiom_of_choice ∈ Th Set' := sorry

lemma Set'_models_infinity : axiom_of_infinity ∈ Th Set' :=
begin
  simp [has_mem.mem, set.mem, Th, set_of, axiom_of_infinity,satisfied_in],
  refine ⟨Set.omega, _⟩, refine ⟨_,_⟩, refine ⟨Set.empty,_⟩,
  refine ⟨Set'_realize_empty, by {change Set.empty ∈ Set.omega, exact Set.omega_zero}⟩,
  intros, refine ⟨Set.insert x x, _⟩, refine ⟨_,@Set.omega_succ x a⟩,
  exact (iff.mpr Set.mem_insert (or.inl (refl x)))
end

lemma Set'_models_infinity' : axiom_of_infinity' ∈ Th Set' :=
begin
  simp [has_mem.mem, set.mem, Th, set_of, axiom_of_infinity' ,satisfied_in,realize_cast_bounded_formula],
  refine ⟨Set.omega, _⟩, intro x, refine ⟨_,_⟩,
  {intro H_x, change Set.mem x _, change _ ∈ Set.omega,
  suffices : x = Set.empty, by rw[this]; apply Set.omega_zero, exact H_x},
  intro y, conv in (dvector.nth _ _ _) {change x}, conv in (dvector.nth _ _ _) {change y},
  change Set.mem y Set.omega → _, intro H,
  exact ⟨Set.insert y y, ⟨iff.mpr Set.mem_insert (or.inl (by refl)), @Set.omega_succ y H⟩⟩
end

lemma Set'_models_shallow_infinity : Set_axiom_of_infinity :=
begin
  unfold Set_axiom_of_infinity Set_is_emptyset, refine ⟨Set.omega, _⟩,
  split,
    {refine ⟨∅, ⟨_, Set.omega_zero⟩⟩, apply Set.mem_empty},
    {intros z H, refine ⟨Set.insert z z, ⟨iff.mpr Set.mem_insert (or.inl (by refl)), @Set.omega_succ z H⟩⟩},
end

lemma shallow_infinity_iff_shallow_infinity' : Set_axiom_of_infinity ↔ Set_axiom_of_infinity' :=
  sorry

lemma Set'_infinity_shallow_infinity : Set'[axiom_of_infinity] ↔ Set_axiom_of_infinity  :=
  sorry

lemma Set'_infinity'_shallow_infinity' :  Set'[axiom_of_infinity'] ↔ Set_axiom_of_infinity' :=
  sorry

example : axiom_of_infinity ∈ Th(Set') :=
  Set'_infinity_shallow_infinity.mpr Set'_models_shallow_infinity

example : axiom_of_infinity' ∈ Th(Set') :=
      Set'_infinity'_shallow_infinity'.mpr $ shallow_infinity_iff_shallow_infinity'.mp Set'_models_shallow_infinity

@[simp]lemma Set'_functional_rw : ∀ c : bounded_formula L_ZFC 2, @realize_bounded_formula L_ZFC Set' 0 0 dvector.nil (functional c) dvector.nil = ∀ x : Set, ∃ y : Set, ∀ w, @realize_bounded_formula L_ZFC Set' 3 0  ([w,y,x]) ( (c ↑' 1 # 1) ⇔ &0 ≃ &1)  dvector.nil :=
begin
intros c,
ext1, simp at *, rw [functional, realize_bounded_formula],
simp [realize_bounded_formula_ex],
refl
end

lemma Set'_functional : ∀ c, @realize_bounded_formula L_ZFC Set' 0 0 dvector.nil (functional c) dvector.nil → Set → Set :=
begin
  intro c, rw[Set'_functional_rw], intros h s, sorry
end

lemma Set'_models_replacement: ∀ c : bounded_formula L_ZFC 2, axiom_of_replacement c ∈ Th Set' :=
begin
intro c,
simp only [has_mem.mem,set.mem,Th,set_of,axiom_of_replacement],
intros a x,
sorry
end

lemma Set_extends_ZFC : ZFC ⊆ Th Set' :=
begin
intros f hf, cases hf with zf choice,
repeat{cases zf},
  exact Set'_models_infinity, exact Set'_models_powerset,
  exact Set'_models_union, exact Set'_models_extensionality,
  dsimp at zf_h, cases zf_h with a b, subst b,
  revert zf_w, simp, exact Set'_models_replacement,
  repeat{cases choice}, exact Set'_models_choice
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.baire
import Mathlib.analysis.normed_space.operator_norm
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Banach open mapping theorem

This file contains the Banach open mapping theorem, i.e., the fact that a bijective
bounded linear map between Banach spaces has a bounded inverse.
-/

/--
First step of the proof of the Banach open mapping theorem (using completeness of `F`):
by Baire's theorem, there exists a ball in `E` whose image closure has nonempty interior.
Rescaling everything, it follows that any `y ∈ F` is arbitrarily well approached by
images of elements of norm at most `C * ∥y∥`.
For further use, we will only need such an element whose image
is within distance `∥y∥/2` of `y`, to apply an iterative process. -/
theorem exists_approx_preimage_norm_le {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) [complete_space F] (surj : function.surjective ⇑f) :
    ∃ (C : ℝ),
        ∃ (H : C ≥ 0),
          ∀ (y : F), ∃ (x : E), dist (coe_fn f x) y ≤ 1 / bit0 1 * norm y ∧ norm x ≤ C * norm y :=
  sorry

/-- The Banach open mapping theorem: if a bounded linear map between Banach spaces is onto, then
any point has a preimage with controlled norm. -/
theorem exists_preimage_norm_le {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) [complete_space F] [complete_space E]
    (surj : function.surjective ⇑f) :
    ∃ (C : ℝ), ∃ (H : C > 0), ∀ (y : F), ∃ (x : E), coe_fn f x = y ∧ norm x ≤ C * norm y :=
  sorry

/-- The Banach open mapping theorem: a surjective bounded linear map between Banach spaces is
open. -/
theorem open_mapping {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) [complete_space F] [complete_space E]
    (surj : function.surjective ⇑f) : is_open_map ⇑f :=
  sorry

namespace linear_equiv

/-- If a bounded linear map is a bijection, then its inverse is also a bounded linear map. -/
theorem continuous_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [complete_space F]
    [complete_space E] (e : linear_equiv 𝕜 E F) (h : continuous ⇑e) : continuous ⇑(symm e) :=
  sorry

/-- Associating to a linear equivalence between Banach spaces a continuous linear equivalence when
the direct map is continuous, thanks to the Banach open mapping theorem that ensures that the
inverse map is also continuous. -/
def to_continuous_linear_equiv_of_continuous {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] [complete_space F] [complete_space E] (e : linear_equiv 𝕜 E F)
    (h : continuous ⇑e) : continuous_linear_equiv 𝕜 E F :=
  continuous_linear_equiv.mk (mk (to_fun e) sorry sorry (inv_fun e) sorry sorry)

@[simp] theorem coe_fn_to_continuous_linear_equiv_of_continuous {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3}
    [normed_group F] [normed_space 𝕜 F] [complete_space F] [complete_space E]
    (e : linear_equiv 𝕜 E F) (h : continuous ⇑e) :
    ⇑(to_continuous_linear_equiv_of_continuous e h) = ⇑e :=
  rfl

@[simp] theorem coe_fn_to_continuous_linear_equiv_of_continuous_symm {𝕜 : Type u_1}
    [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3}
    [normed_group F] [normed_space 𝕜 F] [complete_space F] [complete_space E]
    (e : linear_equiv 𝕜 E F) (h : continuous ⇑e) :
    ⇑(continuous_linear_equiv.symm (to_continuous_linear_equiv_of_continuous e h)) = ⇑(symm e) :=
  rfl

end linear_equiv

namespace continuous_linear_equiv

/-- Convert a bijective continuous linear map `f : E →L[𝕜] F` between two Banach spaces
to a continuous linear equivalence. -/
def of_bijective {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [complete_space F]
    [complete_space E] (f : continuous_linear_map 𝕜 E F) (hinj : continuous_linear_map.ker f = ⊥)
    (hsurj : continuous_linear_map.range f = ⊤) : continuous_linear_equiv 𝕜 E F :=
  linear_equiv.to_continuous_linear_equiv_of_continuous (linear_equiv.of_bijective (↑f) hinj hsurj)
    sorry

@[simp] theorem coe_fn_of_bijective {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    [complete_space F] [complete_space E] (f : continuous_linear_map 𝕜 E F)
    (hinj : continuous_linear_map.ker f = ⊥) (hsurj : continuous_linear_map.range f = ⊤) :
    ⇑(of_bijective f hinj hsurj) = ⇑f :=
  rfl

@[simp] theorem of_bijective_symm_apply_apply {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] [complete_space F] [complete_space E] (f : continuous_linear_map 𝕜 E F)
    (hinj : continuous_linear_map.ker f = ⊥) (hsurj : continuous_linear_map.range f = ⊤) (x : E) :
    coe_fn (continuous_linear_equiv.symm (of_bijective f hinj hsurj)) (coe_fn f x) = x :=
  symm_apply_apply (of_bijective f hinj hsurj) x

@[simp] theorem of_bijective_apply_symm_apply {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] [complete_space F] [complete_space E] (f : continuous_linear_map 𝕜 E F)
    (hinj : continuous_linear_map.ker f = ⊥) (hsurj : continuous_linear_map.range f = ⊤) (y : F) :
    coe_fn f (coe_fn (continuous_linear_equiv.symm (of_bijective f hinj hsurj)) y) = y :=
  apply_symm_apply (of_bijective f hinj hsurj) y

end Mathlib


import condensed.adjunctions
import condensed.extr.equivalence
import condensed.short_exact
import condensed.acyclic

import for_mathlib.AddCommGroup.tensor

noncomputable theory

universes u
open_locale tensor_product

open category_theory

namespace ExtrSheafProd

@[simps obj map]
def tensor_presheaf (M : ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1}) (A : Ab.{u+1}) :
  ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1} :=
M ⋙ AddCommGroup.tensor_functor.flip.obj A

@[simps val]
def tensor (M : ExtrSheafProd.{u} Ab.{u+1}) (A : Ab.{u+1}) :
  ExtrSheafProd.{u} Ab.{u+1} :=
{ val := tensor_presheaf M.val A,
  cond := begin
    introsI α _ X, dsimp [tensor_presheaf, AddCommGroup.tensor_functor],
    let e := _, change is_iso e,
    have hq := M.cond _ X, dsimp at hq, let q := _, change is_iso q at hq,
    have he : e = AddCommGroup.map_tensor q (𝟙 _) ≫
      AddCommGroup.tensor_pi_comparison _ _,
    { ext1 j,
      dsimp [AddCommGroup.tensor_pi_comparison],
      simp only [←AddCommGroup.map_tensor_comp_left, limits.limit.lift_π,
        limits.fan.mk_π_app, category.assoc]},
    rw he, resetI, apply_with is_iso.comp_is_iso { instances := ff },
    swap, apply_instance,
    use AddCommGroup.map_tensor (inv q) (𝟙 _),
    split,
    { rw [← AddCommGroup.map_tensor_comp_left, is_iso.hom_inv_id, AddCommGroup.map_tensor_id], },
    { rw [← AddCommGroup.map_tensor_comp_left, is_iso.inv_hom_id, AddCommGroup.map_tensor_id], },
  end } -- tensor products commutes with direct sums.

@[simps val_app]
def map_tensor {M M' : ExtrSheafProd.{u} Ab.{u+1}} {A A' : AddCommGroup.{u+1}}
  (f : M ⟶ M') (g : A ⟶ A') :
  M.tensor A ⟶ M'.tensor A' := ExtrSheafProd.hom.mk $
{ app := λ S, AddCommGroup.map_tensor (f.val.app _) g,
  naturality' := begin
    intros X Y i,
    dsimp [tensor, tensor_presheaf],
    simp only [← AddCommGroup.map_tensor_comp_comp, category.id_comp, category.comp_id,
      f.val.naturality],
  end }

@[simp]
lemma map_tensor_id (M : ExtrSheafProd.{u} Ab.{u+1}) (A : AddCommGroup.{u+1}) :
  map_tensor (𝟙 M) (𝟙 A) = 𝟙 _ :=
by { ext : 3, dsimp, simp }

@[simp]
lemma map_tensor_comp {M M' M'' : ExtrSheafProd.{u} Ab.{u+1}}
  {A A' A'' : AddCommGroup.{u+1}}
  (f : M ⟶ M') (f' : M' ⟶ M'')
  (g : A ⟶ A') (g' : A' ⟶ A'') :
  map_tensor (f ≫ f') (g ≫ g') = map_tensor f g ≫ map_tensor f' g' :=
by { ext : 3, dsimp, simp }

-- Slow, so probably break into pieces
@[simps]
def tensor_functor : ExtrSheafProd.{u} Ab.{u+1} ⥤ Ab.{u+1} ⥤ ExtrSheafProd.{u} Ab.{u+1} :=
{ obj := λ M,
  { obj := λ A, M.tensor A,
    map := λ A A' f, map_tensor (𝟙 _) f,
    map_id' := λ X, by simp,
    map_comp' := λ X Y Z f g, begin
      nth_rewrite 0 [← category.id_comp (𝟙 M)],
      rw map_tensor_comp,
    end },
  map := λ M N f,
  { app := λ A, map_tensor f (𝟙 _),
    naturality' := λ A B g, begin
      dsimp,
      simp only [← map_tensor_comp, category.id_comp, category.comp_id],
    end },
  map_id' := λ M, begin
    ext : 2,
    simp,
  end,
  map_comp' := λ M N L f g, begin
    ext x : 2,
    dsimp,
    nth_rewrite 0 [← category.comp_id (𝟙 x)],
    rw [map_tensor_comp],
  end }
.

@[simps]
instance hom_has_add {M N : ExtrSheafProd.{u} Ab.{u+1}} : has_add (M ⟶ N) :=
⟨λ f g, ⟨f.val + g.val⟩⟩

@[simps]
instance hom_has_zero {M N : ExtrSheafProd.{u} Ab.{u+1}} : has_zero (M ⟶ N) :=
⟨⟨0⟩⟩

@[simps]
instance hom_has_neg {M N : ExtrSheafProd.{u} Ab.{u+1}} : has_neg (M ⟶ N) :=
⟨λ f, ⟨-f.val⟩⟩

@[simps]
instance hom_has_sub {M N : ExtrSheafProd.{u} Ab.{u+1}} : has_sub (M ⟶ N) :=
⟨λ f g, ⟨f.val - g.val⟩⟩

instance preadditive : preadditive (ExtrSheafProd.{u} Ab.{u+1}) :=
{ hom_group := λ P Q,
  { add_assoc := λ f g h, by { ext1, dsimp, rw add_assoc },
    zero_add := λ f, by { ext1, dsimp, rw zero_add },
    add_zero := λ f, by { ext1, dsimp, rw add_zero },
    nsmul := λ n f, ⟨n • f.val⟩,
    nsmul_zero' := λ f, by { ext1, dsimp, simp, },
    nsmul_succ' := λ n f, by { ext1, dsimp, exact succ_nsmul f.val n },
    sub_eq_add_neg := λ f g, by { ext1, dsimp, exact sub_eq_add_neg f.val g.val },
    zsmul := λ n f, ⟨n • f.val⟩,
    zsmul_zero' := λ f, by { ext1, dsimp, simp },
    zsmul_succ' := λ n f, by { ext1, dsimp, rw [nat.cast_succ, add_zsmul, one_zsmul, add_comm], },
    zsmul_neg' := λ n f, by { ext1, dsimp, simpa, },
    add_left_neg := λ f, by { ext1, dsimp, simp },
    add_comm := λ f g, by { ext1, dsimp, rw add_comm },
    ..(infer_instance : has_add _),
    ..(infer_instance : has_neg _),
    ..(infer_instance : has_zero _),
    ..(infer_instance : has_sub _) },
  add_comp' := λ P Q R f f' g, by { ext1, dsimp, simp },
  comp_add' := λ P Q R f g g', by { ext1, dsimp, simp } }

def evaluation (S : ExtrDisc.{u}) :
  ExtrSheafProd.{u} Ab.{u+1} ⥤ Ab.{u+1} :=
ExtrSheafProd_to_presheaf _ ⋙ (evaluation _ _).obj (opposite.op S)

instance evaluation_additive (S) : functor.additive (evaluation S) :=
⟨λ M N f g, rfl⟩

@[simps]
def half_internal_hom (A : AddCommGroup.{u+1}) (M : ExtrSheafProd.{u} Ab.{u+1}) :
  ExtrSheafProd.{u} Ab.{u+1} :=
{ val :=
  { obj := λ S, AddCommGroup.of (A ⟶ M.val.obj S),
    map := λ X Y f, (preadditive_yoneda.flip.obj (opposite.op A)).map $ M.val.map f,
    map_id' := begin
      intros S,
      dsimp, simpa,
    end,
    map_comp' := begin
      intros R S T f g,
      dsimp,
      simp,
    end },
  cond := begin
    introsI α _ X, dsimp,
    let t := _, change is_iso t,
    have := M.cond α X, dsimp at this, let e := _, change is_iso e at this, resetI,
    let q : AddCommGroup.of (A ⟶ M.val.obj (opposite.op (ExtrDisc.sigma X))) ≅
      AddCommGroup.of (A ⟶ (∏ (λ i, M.val.obj (opposite.op (X i))))) :=
      (preadditive_yoneda.flip.obj (opposite.op A)).map_iso (as_iso e),
    let s : AddCommGroup.of (A ⟶ (∏ (λ i, M.val.obj (opposite.op (X i))))) ⟶
      ∏ (λ i, AddCommGroup.of (A ⟶ M.val.obj (opposite.op (X i)))) :=
      limits.pi.lift (λ i, (preadditive_yoneda.flip.obj (opposite.op A)).map
        (limits.pi.π _ i)),
    have ht : t = q.hom ≫ s,
    { dsimp [t, q, s, e], ext1,
      simp only [limits.limit.lift_π, limits.fan.mk_π_app, category.assoc],
      rw [← nat_trans.comp_app, ← functor.map_comp, limits.limit.lift_π],
      refl },
    rw ht, clear ht,
    suffices : is_iso s,
    { resetI, apply is_iso.comp_is_iso },
    -- Now we need to show that `Hom(A,(Π i, X i)) = Π i, Hom(A,X i)`.
    apply AddCommGroup.is_iso_hom_product_comparison.{u u+1},
  end }

def tensor_uncurry {A : AddCommGroup.{u+1}} {M N : ExtrSheafProd.{u} Ab.{u+1}}
  (e : M ⟶ half_internal_hom A N) :
  tensor M A ⟶ N := ExtrSheafProd.hom.mk $
{ app := λ S, AddCommGroup.tensor_uncurry $ e.val.app _,
  naturality' := begin
    intros X Y f,
    erw ← AddCommGroup.tensor_uncurry_comp_curry,
    apply (AddCommGroup.tensor_curry_equiv _ _ _).injective,
    erw (AddCommGroup.tensor_curry_equiv _ _ _).apply_symm_apply,
    dsimp [AddCommGroup.tensor_curry_equiv],
    erw [AddCommGroup.tensor_curry_uncurry_comp, ← nat_trans.naturality,
      ← AddCommGroup.tensor_curry_equiv_apply,
      ← AddCommGroup.tensor_curry_equiv_symm_apply,
      (AddCommGroup.tensor_curry_equiv _ _ _).apply_symm_apply],
  end }

def tensor_curry {A : AddCommGroup.{u+1}} {M N : ExtrSheafProd.{u} Ab.{u+1}}
  (e : M.tensor A ⟶ N) : M ⟶ half_internal_hom A N := ExtrSheafProd.hom.mk $
{ app := λ S, AddCommGroup.tensor_curry $ e.val.app _,
  naturality' := begin
    intros X Y f,
    dsimp [half_internal_hom],
    erw [← AddCommGroup.tensor_curry_uncurry_comp],
    apply (AddCommGroup.tensor_curry_equiv _ _ _).symm.injective,
    simp_rw ← AddCommGroup.tensor_curry_equiv_apply,
    rw (AddCommGroup.tensor_curry_equiv _ _ _).symm_apply_apply,
    rw ← AddCommGroup.tensor_curry_equiv_symm_apply,
    rw (AddCommGroup.tensor_curry_equiv _ _ _).symm_apply_apply,
    dsimp,
    rw [AddCommGroup.tensor_uncurry_comp_curry, ← nat_trans.naturality],
    refl,
  end }

lemma tensor_curry_uncurry {A : AddCommGroup.{u+1}} {M N : ExtrSheafProd.{u} Ab.{u+1}}
  (e : M ⟶ half_internal_hom A N) :
  tensor_curry (tensor_uncurry e) = e :=
begin
  ext S : 3,
  dsimp [tensor_curry, tensor_uncurry],
  simp,
end

lemma tensor_uncurry_curry {A : AddCommGroup.{u+1}} {M N : ExtrSheafProd.{u} Ab.{u+1}}
  (e : M.tensor A ⟶ N) :
  tensor_uncurry (tensor_curry e) = e :=
begin
  ext S : 3,
  dsimp [tensor_curry, tensor_uncurry],
  simp,
end

instance tensor_functor_additive (M : ExtrSheafProd.{u} Ab.{u+1}) :
  (tensor_functor.obj M).additive := { }

instance tensor_functor_flip_additive (A : Ab.{u+1}) :
  (tensor_functor.flip.obj A).additive := { }

end ExtrSheafProd

namespace ExtrSheaf

def tensor (M : ExtrSheaf.{u} Ab.{u+1}) (A : AddCommGroup.{u+1}) :
  ExtrSheaf.{u} Ab.{u+1} :=
(ExtrSheaf_ExtrSheafProd_equiv _).inverse.obj $
((ExtrSheaf_ExtrSheafProd_equiv _).functor.obj M).tensor A

@[simp]
lemma tensor_val_obj (M : ExtrSheaf.{u} Ab.{u+1}) (A : AddCommGroup.{u+1}) (T) :
  (M.tensor A).val.obj T = (M.val.obj T).tensor A := rfl

def half_internal_hom (A : AddCommGroup.{u+1}) (M : ExtrSheaf.{u} Ab.{u+1}) :
  ExtrSheaf.{u} Ab.{u+1} :=
(ExtrSheaf_ExtrSheafProd_equiv _).inverse.obj $
((ExtrSheaf_ExtrSheafProd_equiv _).functor.obj M).half_internal_hom A

@[simp]
lemma half_internal_hom_val_obj (A : AddCommGroup.{u+1}) (M : ExtrSheaf.{u} Ab.{u+1}) (T) :
  (M.half_internal_hom A).val.obj T =
  AddCommGroup.of (A ⟶ M.val.obj T) := rfl

def tensor_curry {A : AddCommGroup.{u+1}} {M N : ExtrSheaf.{u} Ab.{u+1}}
  (e : M.tensor A ⟶ N) :
  M ⟶ N.half_internal_hom A :=
⟨(ExtrSheafProd.tensor_curry $ (ExtrSheaf_ExtrSheafProd_equiv _).functor.map e).val⟩

def tensor_uncurry {A : AddCommGroup.{u+1}} {M N : ExtrSheaf.{u} Ab.{u+1}}
  (e : M ⟶ N.half_internal_hom A) :
  M.tensor A ⟶ N :=
⟨(ExtrSheafProd.tensor_uncurry $ (ExtrSheaf_ExtrSheafProd_equiv _).functor.map e).val⟩

@[simps val]
def map_tensor {M M' : ExtrSheaf.{u} Ab.{u+1}} {A A' : AddCommGroup.{u+1}}
  (f : M ⟶ M') (g : A ⟶ A') :
  M.tensor A ⟶ M'.tensor A' :=
⟨((ExtrSheafProd.map_tensor $ (ExtrSheaf_ExtrSheafProd_equiv _).functor.map f) g).val⟩

@[simp]
lemma map_tensor_id (M : ExtrSheaf.{u} Ab.{u+1}) (A : AddCommGroup.{u+1}) :
  map_tensor (𝟙 M) (𝟙 A) = 𝟙 _ :=
by { ext : 1, dsimp, simpa, }

@[simp]
lemma map_tensor_comp {M M' M'' : ExtrSheaf.{u} Ab.{u+1}}
  {A A' A'' : AddCommGroup.{u+1}}
  (f : M ⟶ M') (f' : M' ⟶ M'')
  (g : A ⟶ A') (g' : A' ⟶ A'') :
  map_tensor (f ≫ f') (g ≫ g') = map_tensor f g ≫ map_tensor f' g' :=
by { ext : 1, dsimp, simp }

@[simps]
def tensor_functor : ExtrSheaf.{u} Ab.{u+1} ⥤ Ab.{u+1} ⥤ ExtrSheaf.{u} Ab.{u+1} :=
{ obj := λ M,
  { obj := λ A, M.tensor A,
    map := λ A A' f, map_tensor (𝟙 _) f,
    map_id' := λ X, by simp,
    map_comp' := λ X Y Z f g, begin
      nth_rewrite 0 [← category.id_comp (𝟙 M)],
      rw map_tensor_comp,
    end },
  map := λ M N f,
  { app := λ A, map_tensor f (𝟙 _),
    naturality' := λ A B g, begin
      dsimp,
      simp only [← map_tensor_comp, category.id_comp, category.comp_id],
    end },
  map_id' := λ M, begin
    ext : 2,
    simp,
  end,
  map_comp' := λ M N L f g, begin
    ext x : 2,
    dsimp,
    nth_rewrite 0 [← category.comp_id (𝟙 x)],
    rw [map_tensor_comp],
  end }

instance creates_colimits :
  creates_colimits
  (Sheaf_to_presheaf ExtrDisc.proetale_topology.{u} Ab.{u+1}) :=
show creates_colimits ((ExtrSheaf_ExtrSheafProd_equiv _).functor ⋙
  ExtrSheafProd_to_presheaf _), from infer_instance

instance preserves_colimits_tensor_obj (M : ExtrSheaf.{u} Ab.{u+1}) :
  limits.preserves_colimits (tensor_functor.obj M) :=
begin
  constructor, introsI J _, constructor, intros F, constructor, intros S hS,
  let T := _, change (limits.is_colimit T),
  apply limits.is_colimit_of_reflects
    (Sheaf_to_presheaf ExtrDisc.proetale_topology.{u} Ab.{u+1}),
  apply limits.evaluation_jointly_reflects_colimits,
  intros Q,
  change limits.is_colimit
    ((AddCommGroup.tensor_functor.obj (M.val.obj Q)).map_cocone S),
  apply limits.is_colimit_of_preserves,
  exact hS,
end

example (α : Type (u+1)) (N : ExtrSheaf.{u} Ab.{u+1}) :
limits.preserves_colimits_of_shape (discrete α) (tensor_functor.obj N) := infer_instance

instance tensor_functor_additive (M : ExtrSheaf.{u} Ab.{u+1}) :
  (tensor_functor.obj M).additive := { }

end ExtrSheaf

namespace Condensed

def tensor (M : Condensed.{u} Ab.{u+1}) (A : Ab.{u+1}) :
  Condensed.{u} Ab.{u+1} :=
(Condensed_ExtrSheaf_equiv _).functor.obj
(((Condensed_ExtrSheaf_equiv _).inverse.obj M).tensor A)

def map_tensor {M M' : Condensed.{u} Ab.{u+1}} {A A' : Ab.{u+1}}
  (f : M ⟶ M') (g : A ⟶ A') :
  M.tensor A ⟶ M'.tensor A' :=
(Condensed_ExtrSheaf_equiv _).functor.map $
ExtrSheaf.map_tensor ((Condensed_ExtrSheaf_equiv _).inverse.map f) g

@[simp]
lemma map_tensor_id (M : Condensed.{u} Ab.{u+1}) (A : AddCommGroup.{u+1}) :
  map_tensor (𝟙 M) (𝟙 A) = 𝟙 _ :=
by { dsimp [map_tensor], simpa, }

@[simp]
lemma map_tensor_comp {M M' M'' : Condensed.{u} Ab.{u+1}}
  {A A' A'' : AddCommGroup.{u+1}}
  (f : M ⟶ M') (f' : M' ⟶ M'')
  (g : A ⟶ A') (g' : A' ⟶ A'') :
  map_tensor (f ≫ f') (g ≫ g') = map_tensor f g ≫ map_tensor f' g' :=
by { dsimp [map_tensor], simp, }

/-- This is the functor that sends `A : Ab` to `M ⊗ A`,
where `M` is a condensed abelian group, functorial in both `M` and `A`. -/
def tensor_functor : Condensed.{u} Ab.{u+1} ⥤ Ab.{u+1} ⥤ Condensed.{u} Ab.{u+1} :=
{ obj := λ M,
  { obj := λ A, M.tensor A,
    map := λ A A' f, map_tensor (𝟙 _) f,
    map_id' := λ X, by simp,
    map_comp' := λ X Y Z f g, begin
      nth_rewrite 0 [← category.id_comp (𝟙 M)],
      rw map_tensor_comp,
    end },
  map := λ M N f,
  { app := λ A, map_tensor f (𝟙 _),
    naturality' := λ A B g, begin
      dsimp,
      simp only [← map_tensor_comp, category.id_comp, category.comp_id],
    end },
  map_id' := λ M, begin
    ext : 2,
    simp,
  end,
  map_comp' := λ M N L f g, begin
    ext x : 2,
    dsimp,
    nth_rewrite 0 [← category.comp_id (𝟙 x)],
    rw [map_tensor_comp],
  end }

/-
/-- Restrincting to `ExtrDisc` works as expeceted. -/
def tensor_functor_conj_iso :
  (Condensed_ExtrSheaf_equiv Ab.{u+1}).functor ⋙
  ((whiskering_right _ _ _).obj $ ((whiskering_right _ _ _).obj
    (Condensed_ExtrSheaf_equiv Ab.{u+1}).inverse)).obj tensor_functor ≅
  ExtrSheaf.tensor_functor :=
nat_iso.of_components
(λ X, begin
  dsimp [tensor_functor],
end)
begin
  intros X Y f, ext : 2,
  dsimp [tensor_functor],
  simp only [equivalence.fun_inv_map, equivalence.equivalence_mk'_counit,
    equivalence.equivalence_mk'_counit_inv, functor.map_comp, nat_trans.comp_app,
    category.assoc, iso.inv_hom_id_app_assoc, category.id_comp,
    nat_iso.cancel_nat_iso_hom_left],
  rw [← nat_trans.comp_app, ← functor.map_comp, ← nat_trans.comp_app],
  have : (Condensed_ExtrSheafProd_equiv Ab).counit_iso.inv.app Y ≫
    (Condensed_ExtrSheafProd_equiv Ab).counit_iso.hom.app Y = 𝟙 _,
  { rw [← nat_trans.comp_app, iso.inv_hom_id], refl },
  rw this,
  simp only [nat_trans.comp_app],
  dsimp,
  simp only [category_theory.functor.map_id, nat_trans.id_app, category.comp_id],
end

def tensor_functor_conj_iso' :
  tensor_functor ⋙ (whiskering_right _ _ _).obj
  (Condensed_ExtrSheafProd_equiv _).functor ≅
  (Condensed_ExtrSheafProd_equiv _).functor ⋙ ExtrSheafProd.tensor_functor :=
nat_iso.of_components
(λ X, begin
  dsimp [tensor_functor],
  refine functor.associator _ _ _ ≪≫ _,
  refine _ ≪≫ functor.right_unitor _,
  refine ((whiskering_left _ _ _).obj _).map_iso _,
  refine (Condensed_ExtrSheafProd_equiv _).counit_iso,
end)
begin
  intros X Y f, ext : 2,
  dsimp [tensor_functor],
  simp, dsimp, simp,
end
-/

def tensor_iso (M : Condensed.{u} Ab.{u+1}) (A : Ab.{u+1}) :
  (Condensed_ExtrSheaf_equiv _).inverse.obj (M.tensor A) ≅
  ((Condensed_ExtrSheaf_equiv _).inverse.obj M).tensor A :=
((Condensed_ExtrSheaf_equiv _).unit_iso.app _).symm

/-- The tensor product behaves in the naive way when evaluated
on extremally disconnected sets. -/
def tensor_eval_iso
  (M : Condensed.{u} Ab.{u+1}) (A : Ab.{u+1}) (S : ExtrDisc.{u}) :
  (tensor M A).val.obj (opposite.op S.val) ≅
  ((M.val.obj (opposite.op S.val)).tensor A) :=
((Sheaf_to_presheaf _ _).map_iso (M.tensor_iso A)).app (opposite.op S)

def half_internal_hom (A : AddCommGroup.{u+1}) (M : Condensed.{u} Ab.{u+1}) :
  Condensed.{u} Ab.{u+1} :=
(Condensed_ExtrSheaf_equiv _).functor.obj $
ExtrSheaf.half_internal_hom A ((Condensed_ExtrSheaf_equiv _).inverse.obj M)

def half_internal_hom_iso (A : AddCommGroup.{u+1}) (M : Condensed.{u} Ab.{u+1}) :
  (Condensed_ExtrSheaf_equiv _).inverse.obj (half_internal_hom A M) ≅
  ExtrSheaf.half_internal_hom A ((Condensed_ExtrSheaf_equiv _).inverse.obj M) :=
((Condensed_ExtrSheaf_equiv _).unit_iso.app _).symm

def half_internal_hom_eval_iso (A : AddCommGroup.{u+1}) (M : Condensed.{u} Ab.{u+1})
  (S : ExtrDisc.{u}) :
  (half_internal_hom A M).val.obj (opposite.op S.val) ≅
  AddCommGroup.of (A ⟶ M.val.obj (opposite.op S.val)) :=
((Sheaf_to_presheaf _ _).map_iso (half_internal_hom_iso A M)).app (opposite.op S)

def tensor_uncurry {A : AddCommGroup.{u+1}} {M N : Condensed.{u} Ab.{u+1}}
  (e : M ⟶ half_internal_hom A N) :
  tensor M A ⟶ N :=
(Condensed_ExtrSheaf_equiv _).functor.map
  (ExtrSheaf.tensor_uncurry $ (Condensed_ExtrSheaf_equiv Ab).inverse.map e ≫
  (half_internal_hom_iso _ _).hom) ≫
  ((Condensed_ExtrSheaf_equiv _).counit_iso.app N).hom

lemma tensor_uncurry_eq
  {A : AddCommGroup.{u+1}} {M N : Condensed.{u} Ab.{u+1}}
  (e : M ⟶ half_internal_hom A N) :
  (Condensed_ExtrSheaf_equiv _).inverse.map (tensor_uncurry e) =
  (tensor_iso _ _).hom ≫
  ExtrSheaf.tensor_uncurry
  ((Condensed_ExtrSheaf_equiv _).inverse.map e ≫ (half_internal_hom_iso _ _).hom) :=
begin
  dsimp [tensor_uncurry, half_internal_hom_iso, tensor_iso],
  simp,
end

def tensor_curry {A : AddCommGroup.{u+1}} {M N : Condensed.{u} Ab.{u+1}}
  (e : M.tensor A ⟶ N) : M ⟶ half_internal_hom A N :=
  ((Condensed_ExtrSheaf_equiv _).counit_iso.app _).inv ≫
  (Condensed_ExtrSheaf_equiv _).functor.map
  (ExtrSheaf.tensor_curry $ (tensor_iso M A).inv ≫
  (Condensed_ExtrSheaf_equiv Ab).inverse.map e)

lemma tensor_curry_eq {A : AddCommGroup.{u+1}} {M N : Condensed.{u} Ab.{u+1}}
  (e : M.tensor A ⟶ N) :
  (Condensed_ExtrSheaf_equiv _).inverse.map (tensor_curry e) =
  ExtrSheaf.tensor_curry ((tensor_iso _ _).inv ≫
    (Condensed_ExtrSheaf_equiv Ab).inverse.map e) ≫
  (half_internal_hom_iso _ _).inv :=
begin
  rw iso.eq_comp_inv,
  dsimp [tensor_curry, half_internal_hom_iso, tensor_iso],
  simp only [functor.map_comp, equivalence.fun_inv_map, equivalence.equivalence_mk'_counit,
    category.assoc, iso.inv_hom_id_app],
  simp, dsimp, simp,
  --dsimp,
  --simp only [category.comp_id],
  suffices :
    (Condensed_ExtrSheaf_equiv Ab).inverse.map
      ((Condensed_ExtrSheaf_equiv Ab).counit_iso.inv.app M) ≫
    (Condensed_ExtrSheaf_equiv Ab).unit_iso.inv.app
      ((Condensed_ExtrSheaf_equiv Ab).inverse.obj M) = 𝟙 _,
  { rw reassoc_of this },
  simpa,
end

def tensor_functor_iso_ExtrSheaf_tensor_functor (M : Condensed.{u} Ab.{u+1}) :
  tensor_functor.obj M ≅
    (ExtrSheaf.tensor_functor.obj
      ((Condensed_ExtrSheaf_equiv _).inverse.obj M)) ⋙
    (Condensed_ExtrSheaf_equiv _).functor := by refl

instance (M : Condensed.{u} Ab.{u+1}) :
  limits.preserves_colimits (tensor_functor.obj M) :=
limits.preserves_colimits_of_nat_iso (tensor_functor_iso_ExtrSheaf_tensor_functor M).symm

example (α : Type (u+1)) (M : Condensed.{u} Ab.{u+1}) :
  limits.preserves_colimits_of_shape (discrete α) (tensor_functor.obj M) :=
infer_instance

/- this is an assumption in `main_lemma'` in `breen_deligne/main.lean` and it is
used in `condensed/bd_lemma.lean` -/
instance tensor_functor_additive (A : Condensed.{u} Ab.{u+1}) :
  (tensor_functor.obj A).additive :=
{ map_add' := begin
    intros A B f g,
    dsimp [tensor_functor, map_tensor],
    rw [← functor.map_add], congr' 1, ext S : 3,
    dsimp only [ExtrSheaf.map_tensor, ExtrSheafProd.map_tensor],
    simp only [category_theory.functor.map_id],
    erw [nat_trans.id_app],
    rw [← AddCommGroup.tensor_functor_obj_map, functor.map_add],
    refl,
  end }

end Condensed


import .basic

namespace premodel

--- The Pi-type of a family of premodels is a premodel, with the componentwise operations in terms of `vect.unzip_fam`.
definition pi {th : theory} {α : Type*} (M : α → Type _) [∀ a, premodel th (M a)] : premodel th (Π a, M a) :=
  {
    act :=
      λ n f xs, λ a,
        premodel.act f (xs.unzip_fam a)
  }

attribute [instance] premodel.pi

--- The evaluation defines a morphism from the pi-type to its component.
definition pi_eval {th : theory} {α : Type _} (M : α → Type _) [∀ a, premodel th (M a)] (a : α) : morphism th (Π a, M a) (M a) :=
  ⟨(λ f, f a), by intros _ μ fs; rw [←vect.unzip_fam_eval]; unfold act⟩

end premodel

namespace model

--- The Pi-type of a family of models is virtually a model; i.e.~ up to `funext`.
theorem pi_axiom {th : theory} {α : Type _} {C : α → Type _} [∀ a, model th (C a)] : ∀ {n : ℕ} (r : th.rel n) (var : finord n → Π (a : α), C a) (a : α), optree.elim (@premodel.act th (Π a, C a) _) var (th.rel_lhs r) a = optree.elim (@premodel.act th (Π a, C a) _) var (th.rel_rhs r) a :=
  begin
    intros _ r var a,
    unfold premodel.act at *; dsimp *,
    let dact : Π (a : α) {k : ℕ}, th.op k → vect (C a) k → (C a) := λ a k f rs , premodel.act f rs,
    let dvar : Π (a : α), finord n → (C a) := λ k a, var a k,
    rw [@optree.elim_pi th.op _ α C dact dvar _ a],
    rw [@optree.elim_pi th.op _ α C dact dvar _ a],
    rw [axiom_eq]
  end

#print axioms pi_axiom

namespace unsafe
-- WARNING: Use of `funext`.

--- The Pi-type of a family of models is a model.
definition pi {th : theory} {α : Type _} {C : α → Type _} [∀ a, model th (C a)] : model th (Π a, C a):=
  {
    haxiom := λ _ r var, funext (pi_axiom r var)
  }

#print axioms model.unsafe.pi

end unsafe

end model


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.kernels
import category_theory.limits.preserves.shapes.equalizers
import category_theory.limits.preserves.shapes.zero

/-!
# Preserving (co)kernels

Constructions to relate the notions of preserving (co)kernels and reflecting (co)kernels
to concrete (co)forks.

In particular, we show that `kernel_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,0`, as well as the dual result.
-/

noncomputable theory

universes v₁ v₂ u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v₁} C] [has_zero_morphisms C]
variables {D : Type u₂} [category.{v₂} D] [has_zero_morphisms D]
variables (G : C ⥤ D) [functor.preserves_zero_morphisms G]

namespace category_theory.limits

section kernels
variables {X Y Z : C} {f : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = 0)

/--
The map of a kernel fork is a limit iff
the kernel fork consisting of the mapped morphisms is a limit.
This essentially lets us commute `kernel_fork.of_ι` with `functor.map_cone`.

This is a variant of `is_limit_map_cone_fork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_map_cone_fork_equiv' :
  is_limit (G.map_cone (kernel_fork.of_ι h w)) ≃
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : fork (G.map f) 0) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine fork.ext (iso.refl _) _,
  simp [fork.ι]
end

/--
The property of preserving kernels expressed in terms of kernel forks.

This is a variant of `is_limit_fork_map_of_is_limit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_fork_map_of_is_limit' [preserves_limit (parallel_pair f 0) G]
  (l : is_limit (kernel_fork.of_ι h w)) :
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    fork (G.map f) 0) :=
is_limit_map_cone_fork_equiv' G w (preserves_limit.preserves l)

variables (f) [has_kernel f]

/--
If `G` preserves kernels and `C` has them, then the fork constructed of the mapped morphisms of
a kernel fork is a limit.
-/
def is_limit_of_has_kernel_of_preserves_limit [preserves_limit (parallel_pair f 0) G] :
  is_limit (fork.of_ι (G.map (kernel.ι f))
    (by simp only [←G.map_comp, equalizer.condition, comp_zero, functor.map_zero])
      : fork (G.map f) 0) :=
is_limit_fork_map_of_is_limit' G (kernel.condition f) (kernel_is_kernel f)

instance [preserves_limit (parallel_pair f 0) G] : has_kernel (G.map f) :=
{ exists_limit := ⟨⟨_, is_limit_of_has_kernel_of_preserves_limit G f⟩⟩, }

variables [has_kernel (G.map f)]

/--
If the kernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
kernel of `f`.
-/
def preserves_kernel.of_iso_comparison [i : is_iso (kernel_comparison f G)] :
  preserves_limit (parallel_pair f 0) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (kernel_is_kernel f),
  apply (is_limit_map_cone_fork_equiv' G (kernel.condition f)).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_limit (parallel_pair f 0) G]
/--
If `G` preserves the kernel of `f`, then the kernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_kernel.iso :
  G.obj (kernel f) ≅ kernel (G.map f) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_kernel_of_preserves_limit G f)
  (limit.is_limit _)

@[simp]
lemma preserves_kernel.iso_hom :
  (preserves_kernel.iso G f).hom = kernel_comparison f G :=
rfl

instance : is_iso (kernel_comparison f G) :=
begin
  rw ← preserves_kernel.iso_hom,
  apply_instance
end

end kernels

section cokernels

variables {X Y Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = 0)

/--
The map of a cokernel cofork is a colimit iff
the cokernel cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cokernel_cofork.of_π` with `functor.map_cocone`.

This is a variant of `is_colimit_map_cocone_cofork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_map_cocone_cofork_equiv' :
  is_colimit (G.map_cocone (cokernel_cofork.of_π h w)) ≃
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : cofork (G.map f) 0) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine cofork.ext (iso.refl _) _,
  simp only [cofork.π, iso.refl_hom, id_comp, cocones.precompose_obj_ι,
    nat_trans.comp_app, parallel_pair.ext_hom_app, functor.map_cocone_ι_app,
    cofork.of_π_ι_app],
  apply category.comp_id
end

/--
The property of preserving cokernels expressed in terms of cokernel coforks.

This is a variant of `is_colimit_cofork_map_of_is_colimit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_cofork_map_of_is_colimit' [preserves_colimit (parallel_pair f 0) G]
  (l : is_colimit (cokernel_cofork.of_π h w)) :
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    cofork (G.map f) 0) :=
is_colimit_map_cocone_cofork_equiv' G w (preserves_colimit.preserves l)

variables (f) [has_cokernel f]

/--
If `G` preserves cokernels and `C` has them, then the cofork constructed of the mapped morphisms of
a cokernel cofork is a colimit.
-/
def is_colimit_of_has_cokernel_of_preserves_colimit [preserves_colimit (parallel_pair f 0) G] :
  is_colimit (cofork.of_π (G.map (cokernel.π f))
    (by simp only [←G.map_comp, coequalizer.condition, zero_comp, functor.map_zero])
      : cofork (G.map f) 0) :=
is_colimit_cofork_map_of_is_colimit' G (cokernel.condition f) (cokernel_is_cokernel f)

instance [preserves_colimit (parallel_pair f 0) G] : has_cokernel (G.map f) :=
{ exists_colimit := ⟨⟨_, is_colimit_of_has_cokernel_of_preserves_colimit G f⟩⟩, }

variables [has_cokernel (G.map f)]

/--
If the cokernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
cokernel of `f`.
-/
def preserves_cokernel.of_iso_comparison [i : is_iso (cokernel_comparison f G)] :
  preserves_colimit (parallel_pair f 0) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (cokernel_is_cokernel f),
  apply (is_colimit_map_cocone_cofork_equiv' G (cokernel.condition f)).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_colimit (parallel_pair f 0) G]
/--
If `G` preserves the cokernel of `f`, then the cokernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_cokernel.iso :
  G.obj (cokernel f) ≅ cokernel (G.map f) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_cokernel_of_preserves_colimit G f)
  (colimit.is_colimit _)

@[simp]
lemma preserves_cokernel.iso_inv :
  (preserves_cokernel.iso G f).inv = cokernel_comparison f G :=
rfl

instance : is_iso (cokernel_comparison f G) :=
begin
  rw ← preserves_cokernel.iso_inv,
  apply_instance
end

end cokernels

end category_theory.limits


/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Fin.Basic
import Init.System.Platform

open Nat

@[extern "lean_uint8_of_nat"]
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt8 := UInt8.ofNat
@[extern "lean_uint8_to_nat"]
def UInt8.toNat (n : UInt8) : Nat := n.val.val
@[extern "lean_uint8_add"]
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.val + b.val⟩
@[extern "lean_uint8_sub"]
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.val - b.val⟩
@[extern "lean_uint8_mul"]
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.val * b.val⟩
@[extern "lean_uint8_div"]
def UInt8.div (a b : UInt8) : UInt8 := ⟨a.val / b.val⟩
@[extern "lean_uint8_mod"]
def UInt8.mod (a b : UInt8) : UInt8 := ⟨a.val % b.val⟩
@[extern "lean_uint8_modn"]
def UInt8.modn (a : UInt8) (n : @& Nat) : UInt8 := ⟨Fin.modn a.val n⟩
@[extern "lean_uint8_land"]
def UInt8.land (a b : UInt8) : UInt8 := ⟨Fin.land a.val b.val⟩
@[extern "lean_uint8_lor"]
def UInt8.lor (a b : UInt8) : UInt8 := ⟨Fin.lor a.val b.val⟩
@[extern "lean_uint8_xor"]
def UInt8.xor (a b : UInt8) : UInt8 := ⟨Fin.xor a.val b.val⟩
@[extern "lean_uint8_shift_left"]
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.val <<< (modn b 8).val⟩
@[extern "lean_uint8_shift_right"]
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.val >>> (modn b 8).val⟩
def UInt8.lt (a b : UInt8) : Prop := a.val < b.val
def UInt8.le (a b : UInt8) : Prop := a.val ≤ b.val

instance : OfNat UInt8 n   := ⟨UInt8.ofNat n⟩
instance : Add UInt8       := ⟨UInt8.add⟩
instance : Sub UInt8       := ⟨UInt8.sub⟩
instance : Mul UInt8       := ⟨UInt8.mul⟩
instance : Mod UInt8       := ⟨UInt8.mod⟩
instance : HMod UInt8 Nat UInt8 := ⟨UInt8.modn⟩
instance : Div UInt8       := ⟨UInt8.div⟩
instance : LT UInt8        := ⟨UInt8.lt⟩
instance : LE UInt8        := ⟨UInt8.le⟩

@[extern "lean_uint8_complement"]
def UInt8.complement (a:UInt8) : UInt8 := 0-(a+1)

instance : Complement UInt8 := ⟨UInt8.complement⟩
instance : AndOp UInt8     := ⟨UInt8.land⟩
instance : OrOp UInt8      := ⟨UInt8.lor⟩
instance : Xor UInt8       := ⟨UInt8.xor⟩
instance : ShiftLeft UInt8  := ⟨UInt8.shiftLeft⟩
instance : ShiftRight UInt8 := ⟨UInt8.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint8_dec_lt"]
def UInt8.decLt (a b : UInt8) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint8_dec_le"]
def UInt8.decLe (a b : UInt8) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt8) : Decidable (a < b) := UInt8.decLt a b
instance (a b : UInt8) : Decidable (a ≤ b) := UInt8.decLe a b
instance : Max UInt8 := maxOfLe
instance : Min UInt8 := minOfLe

@[extern "lean_uint16_of_nat"]
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt16 := UInt16.ofNat
@[extern "lean_uint16_to_nat"]
def UInt16.toNat (n : UInt16) : Nat := n.val.val
@[extern "lean_uint16_add"]
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.val + b.val⟩
@[extern "lean_uint16_sub"]
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.val - b.val⟩
@[extern "lean_uint16_mul"]
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.val * b.val⟩
@[extern "lean_uint16_div"]
def UInt16.div (a b : UInt16) : UInt16 := ⟨a.val / b.val⟩
@[extern "lean_uint16_mod"]
def UInt16.mod (a b : UInt16) : UInt16 := ⟨a.val % b.val⟩
@[extern "lean_uint16_modn"]
def UInt16.modn (a : UInt16) (n : @& Nat) : UInt16 := ⟨Fin.modn a.val n⟩
@[extern "lean_uint16_land"]
def UInt16.land (a b : UInt16) : UInt16 := ⟨Fin.land a.val b.val⟩
@[extern "lean_uint16_lor"]
def UInt16.lor (a b : UInt16) : UInt16 := ⟨Fin.lor a.val b.val⟩
@[extern "lean_uint16_xor"]
def UInt16.xor (a b : UInt16) : UInt16 := ⟨Fin.xor a.val b.val⟩
@[extern "lean_uint16_shift_left"]
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.val <<< (modn b 16).val⟩
@[extern "lean_uint16_to_uint8"]
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint8_to_uint16"]
def UInt8.toUInt16 (a : UInt8) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint16_shift_right"]
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.val >>> (modn b 16).val⟩
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
def UInt16.le (a b : UInt16) : Prop := a.val ≤ b.val

instance : OfNat UInt16 n   := ⟨UInt16.ofNat n⟩
instance : Add UInt16       := ⟨UInt16.add⟩
instance : Sub UInt16       := ⟨UInt16.sub⟩
instance : Mul UInt16       := ⟨UInt16.mul⟩
instance : Mod UInt16       := ⟨UInt16.mod⟩
instance : HMod UInt16 Nat UInt16 := ⟨UInt16.modn⟩
instance : Div UInt16       := ⟨UInt16.div⟩
instance : LT UInt16        := ⟨UInt16.lt⟩
instance : LE UInt16        := ⟨UInt16.le⟩

@[extern "lean_uint16_complement"]
def UInt16.complement (a:UInt16) : UInt16 := 0-(a+1)

instance : Complement UInt16 := ⟨UInt16.complement⟩
instance : AndOp UInt16     := ⟨UInt16.land⟩
instance : OrOp UInt16      := ⟨UInt16.lor⟩
instance : Xor UInt16       := ⟨UInt16.xor⟩
instance : ShiftLeft UInt16  := ⟨UInt16.shiftLeft⟩
instance : ShiftRight UInt16 := ⟨UInt16.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint16_dec_lt"]
def UInt16.decLt (a b : UInt16) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint16_dec_le"]
def UInt16.decLe (a b : UInt16) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt16) : Decidable (a < b) := UInt16.decLt a b
instance (a b : UInt16) : Decidable (a ≤ b) := UInt16.decLe a b
instance : Max UInt16 := maxOfLe
instance : Min UInt16 := minOfLe

@[extern "lean_uint32_of_nat"]
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨Fin.ofNat n⟩
@[extern "lean_uint32_of_nat"]
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨⟨n, h⟩⟩
abbrev Nat.toUInt32 := UInt32.ofNat
@[extern "lean_uint32_add"]
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.val + b.val⟩
@[extern "lean_uint32_sub"]
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.val - b.val⟩
@[extern "lean_uint32_mul"]
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.val * b.val⟩
@[extern "lean_uint32_div"]
def UInt32.div (a b : UInt32) : UInt32 := ⟨a.val / b.val⟩
@[extern "lean_uint32_mod"]
def UInt32.mod (a b : UInt32) : UInt32 := ⟨a.val % b.val⟩
@[extern "lean_uint32_modn"]
def UInt32.modn (a : UInt32) (n : @& Nat) : UInt32 := ⟨Fin.modn a.val n⟩
@[extern "lean_uint32_land"]
def UInt32.land (a b : UInt32) : UInt32 := ⟨Fin.land a.val b.val⟩
@[extern "lean_uint32_lor"]
def UInt32.lor (a b : UInt32) : UInt32 := ⟨Fin.lor a.val b.val⟩
@[extern "lean_uint32_xor"]
def UInt32.xor (a b : UInt32) : UInt32 := ⟨Fin.xor a.val b.val⟩
@[extern "lean_uint32_shift_left"]
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.val <<< (modn b 32).val⟩
@[extern "lean_uint32_shift_right"]
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.val >>> (modn b 32).val⟩
@[extern "lean_uint32_to_uint8"]
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint32_to_uint16"]
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint8_to_uint32"]
def UInt8.toUInt32 (a : UInt8) : UInt32 := a.toNat.toUInt32
@[extern "lean_uint16_to_uint32"]
def UInt16.toUInt32 (a : UInt16) : UInt32 := a.toNat.toUInt32

instance : OfNat UInt32 n   := ⟨UInt32.ofNat n⟩
instance : Add UInt32       := ⟨UInt32.add⟩
instance : Sub UInt32       := ⟨UInt32.sub⟩
instance : Mul UInt32       := ⟨UInt32.mul⟩
instance : Mod UInt32       := ⟨UInt32.mod⟩
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
instance : Div UInt32       := ⟨UInt32.div⟩

@[extern "lean_uint32_complement"]
def UInt32.complement (a:UInt32) : UInt32 := 0-(a+1)

instance : Complement UInt32 := ⟨UInt32.complement⟩
instance : AndOp UInt32     := ⟨UInt32.land⟩
instance : OrOp UInt32      := ⟨UInt32.lor⟩
instance : Xor UInt32       := ⟨UInt32.xor⟩
instance : ShiftLeft UInt32  := ⟨UInt32.shiftLeft⟩
instance : ShiftRight UInt32 := ⟨UInt32.shiftRight⟩

@[extern "lean_uint64_of_nat"]
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨Fin.ofNat n⟩
abbrev Nat.toUInt64 := UInt64.ofNat
@[extern "lean_uint64_to_nat"]
def UInt64.toNat (n : UInt64) : Nat := n.val.val
@[extern "lean_uint64_add"]
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.val + b.val⟩
@[extern "lean_uint64_sub"]
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.val - b.val⟩
@[extern "lean_uint64_mul"]
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.val * b.val⟩
@[extern "lean_uint64_div"]
def UInt64.div (a b : UInt64) : UInt64 := ⟨a.val / b.val⟩
@[extern "lean_uint64_mod"]
def UInt64.mod (a b : UInt64) : UInt64 := ⟨a.val % b.val⟩
@[extern "lean_uint64_modn"]
def UInt64.modn (a : UInt64) (n : @& Nat) : UInt64 := ⟨Fin.modn a.val n⟩
@[extern "lean_uint64_land"]
def UInt64.land (a b : UInt64) : UInt64 := ⟨Fin.land a.val b.val⟩
@[extern "lean_uint64_lor"]
def UInt64.lor (a b : UInt64) : UInt64 := ⟨Fin.lor a.val b.val⟩
@[extern "lean_uint64_xor"]
def UInt64.xor (a b : UInt64) : UInt64 := ⟨Fin.xor a.val b.val⟩
@[extern "lean_uint64_shift_left"]
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.val <<< (modn b 64).val⟩
@[extern "lean_uint64_shift_right"]
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.val >>> (modn b 64).val⟩
def UInt64.lt (a b : UInt64) : Prop := a.val < b.val
def UInt64.le (a b : UInt64) : Prop := a.val ≤ b.val
@[extern "lean_uint64_to_uint8"]
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint64_to_uint16"]
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint64_to_uint32"]
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
@[extern "lean_uint8_to_uint64"]
def UInt8.toUInt64 (a : UInt8) : UInt64 := a.toNat.toUInt64
@[extern "lean_uint16_to_uint64"]
def UInt16.toUInt64 (a : UInt16) : UInt64 := a.toNat.toUInt64
@[extern "lean_uint32_to_uint64"]
def UInt32.toUInt64 (a : UInt32) : UInt64 := a.toNat.toUInt64

instance : OfNat UInt64 n   := ⟨UInt64.ofNat n⟩
instance : Add UInt64       := ⟨UInt64.add⟩
instance : Sub UInt64       := ⟨UInt64.sub⟩
instance : Mul UInt64       := ⟨UInt64.mul⟩
instance : Mod UInt64       := ⟨UInt64.mod⟩
instance : HMod UInt64 Nat UInt64 := ⟨UInt64.modn⟩
instance : Div UInt64       := ⟨UInt64.div⟩
instance : LT UInt64        := ⟨UInt64.lt⟩
instance : LE UInt64        := ⟨UInt64.le⟩

@[extern "lean_uint64_complement"]
def UInt64.complement (a:UInt64) : UInt64 := 0-(a+1)

instance : Complement UInt64 := ⟨UInt64.complement⟩
instance : AndOp UInt64     := ⟨UInt64.land⟩
instance : OrOp UInt64      := ⟨UInt64.lor⟩
instance : Xor UInt64       := ⟨UInt64.xor⟩
instance : ShiftLeft UInt64  := ⟨UInt64.shiftLeft⟩
instance : ShiftRight UInt64 := ⟨UInt64.shiftRight⟩

@[extern "lean_bool_to_uint64"]
def Bool.toUInt64 (b : Bool) : UInt64 := if b then 1 else 0

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint64_dec_lt"]
def UInt64.decLt (a b : UInt64) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern "lean_uint64_dec_le"]
def UInt64.decLe (a b : UInt64) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : UInt64) : Decidable (a < b) := UInt64.decLt a b
instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
instance : Max UInt64 := maxOfLe
instance : Min UInt64 := minOfLe

theorem usize_size_gt_zero : USize.size > 0 :=
  Nat.pos_pow_of_pos System.Platform.numBits (Nat.zero_lt_succ _)

@[extern "lean_usize_of_nat"]
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' n usize_size_gt_zero⟩
abbrev Nat.toUSize := USize.ofNat
@[extern "lean_usize_to_nat"]
def USize.toNat (n : USize) : Nat := n.val.val
@[extern "lean_usize_add"]
def USize.add (a b : USize) : USize := ⟨a.val + b.val⟩
@[extern "lean_usize_sub"]
def USize.sub (a b : USize) : USize := ⟨a.val - b.val⟩
@[extern "lean_usize_mul"]
def USize.mul (a b : USize) : USize := ⟨a.val * b.val⟩
@[extern "lean_usize_div"]
def USize.div (a b : USize) : USize := ⟨a.val / b.val⟩
@[extern "lean_usize_mod"]
def USize.mod (a b : USize) : USize := ⟨a.val % b.val⟩
@[extern "lean_usize_modn"]
def USize.modn (a : USize) (n : @& Nat) : USize := ⟨Fin.modn a.val n⟩
@[extern "lean_usize_land"]
def USize.land (a b : USize) : USize := ⟨Fin.land a.val b.val⟩
@[extern "lean_usize_lor"]
def USize.lor (a b : USize) : USize := ⟨Fin.lor a.val b.val⟩
@[extern "lean_usize_xor"]
def USize.xor (a b : USize) : USize := ⟨Fin.xor a.val b.val⟩
@[extern "lean_usize_shift_left"]
def USize.shiftLeft (a b : USize) : USize := ⟨a.val <<< (modn b System.Platform.numBits).val⟩
@[extern "lean_usize_shift_right"]
def USize.shiftRight (a b : USize) : USize := ⟨a.val >>> (modn b System.Platform.numBits).val⟩
@[extern "lean_uint32_to_usize"]
def UInt32.toUSize (a : UInt32) : USize := a.toNat.toUSize
@[extern "lean_usize_to_uint32"]
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32

def USize.lt (a b : USize) : Prop := a.val < b.val
def USize.le (a b : USize) : Prop := a.val ≤ b.val

instance : OfNat USize n   := ⟨USize.ofNat n⟩
instance : Add USize       := ⟨USize.add⟩
instance : Sub USize       := ⟨USize.sub⟩
instance : Mul USize       := ⟨USize.mul⟩
instance : Mod USize       := ⟨USize.mod⟩
instance : HMod USize Nat USize := ⟨USize.modn⟩
instance : Div USize       := ⟨USize.div⟩
instance : LT USize        := ⟨USize.lt⟩
instance : LE USize        := ⟨USize.le⟩

@[extern "lean_usize_complement"]
def USize.complement (a:USize) : USize := 0-(a+1)

instance : Complement USize := ⟨USize.complement⟩
instance : AndOp USize      := ⟨USize.land⟩
instance : OrOp USize       := ⟨USize.lor⟩
instance : Xor USize        := ⟨USize.xor⟩
instance : ShiftLeft USize  := ⟨USize.shiftLeft⟩
instance : ShiftRight USize := ⟨USize.shiftRight⟩

set_option bootstrap.genMatcherCode false in
@[extern "lean_usize_dec_lt"]
def USize.decLt (a b : USize) : Decidable (a < b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))

set_option bootstrap.genMatcherCode false in
@[extern "lean_usize_dec_le"]
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
  match a, b with
  | ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))

instance (a b : USize) : Decidable (a < b) := USize.decLt a b
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b
instance : Max USize := maxOfLe
instance : Min USize := minOfLe

theorem USize.modn_lt {m : Nat} : ∀ (u : USize), m > 0 → USize.toNat (u % m) < m
  | ⟨u⟩, h => Fin.modn_lt u h