import tactic
import fol
import Rings.Notation
import Rings.ToMathlib
import Rings.ToMathlib.fol
import Rings.ToMathlib.dvector
import Rings.ToMathlib.fin
import data.polynomial.eval
import data.mv_polynomial

universe u

local infix ` ≃ `:64 := fol.bounded_preformula.bd_equal

namespace Rings

local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

/-- The constant symbols in RingSignature -/
inductive ring_consts : Type*
| zero : ring_consts
| one : ring_consts

/-- The unary function symbols in RingSignature-/
inductive ring_unaries : Type*
| neg : ring_unaries

/-- The binary function symbols in RingSignature-/
inductive ring_binaries : Type*
| add : ring_binaries
| mul : ring_binaries

/-- All function symbols in RingSignature-/
def ring_funcs : ℕ → Type*
| 0 := ring_consts
| 1 := ring_unaries
| 2 := ring_binaries
| (n + 3) := pempty

instance : inhabited ring_consts := ⟨ ring_consts.zero ⟩
instance : inhabited ring_unaries := ⟨ ring_unaries.neg ⟩
instance : inhabited ring_binaries := ⟨ ring_binaries.add ⟩

open fol

/-- The language of rings -/
def ring_signature : Language :=
(Language.mk) (ring_funcs) (λ n, pempty)

@[reducible] def bounded_ring_formula (n : ℕ) := bounded_formula ring_signature n
@[reducible] def bounded_ring_term (n : ℕ) := bounded_term ring_signature n
@[reducible] def bounded_ring_term' (n : ℕ) := bounded_preterm ring_signature n 0
@[reducible] def realize_bounded_ring_term := @realize_bounded_term ring_signature

namespace ring_signature

/- The following instances allow us to use symbols 0 1 - + *-/
/- to write down terms in the language-/

-- @[simp] def zero {n} : bounded_ring_term n := bd_func ring_consts.zero
@[reducible] instance bounded_ring_term_has_zero {n} :
  has_zero (bounded_ring_term n) := ⟨ bd_func ring_consts.zero ⟩
@[reducible] instance bounded_ring_term_has_zero' {n} :
  has_zero (bounded_ring_term' n) := ⟨ bd_func ring_consts.zero ⟩

-- @[simp] def one {n} : bounded_ring_term n := bd_func ring_consts.one
@[reducible] instance bounded_ring_term_has_one {n} :
  has_one (bounded_ring_term n) := ⟨ bd_func ring_consts.one ⟩
@[reducible] instance bounded_ring_term_has_one' {n} :
  has_one (bounded_ring_term' n) := ⟨ bd_func ring_consts.one ⟩

-- @[simp] def neg {n} : bounded_ring_term n → bounded_ring_term n := bd_app (bd_func ring_unaries.neg)
@[reducible] instance bounded_ring_term_has_neg {n} : has_neg (bounded_ring_term n) :=
⟨ bd_app (bd_func ring_unaries.neg) ⟩
@[reducible] instance bounded_ring_term_has_neg' {n} : has_neg (bounded_ring_term' n) :=
⟨ bd_app (bd_func ring_unaries.neg) ⟩

-- @[simp] def add {n} (x : bounded_ring_term n) : bounded_ring_term n → bounded_ring_term n :=
--   bd_app (bd_app (bd_func ring_binaries.add) x)
@[reducible] instance bounded_ring_term_has_add {n} : has_add (bounded_ring_term n) :=
⟨ λ x, bd_app (bd_app (bd_func ring_binaries.add) x) ⟩
@[reducible] instance bounded_ring_term_has_add' {n} : has_add (bounded_ring_term'  n) :=
⟨ λ x, bd_app (bd_app (bd_func ring_binaries.add) x) ⟩

-- @[simp] def mul {n} (x : bounded_ring_term n) : bounded_ring_term n → bounded_ring_term n :=
--   bd_app (bd_app (bd_func ring_binaries.mul) x)
@[reducible] instance bounded_ring_term_has_mul {n} : has_mul (bounded_ring_term n) :=
⟨ λ x, bd_app (bd_app (bd_func ring_binaries.mul) x) ⟩
@[reducible] instance bounded_ring_term_has_mul' {n} : has_mul (bounded_ring_term' n) :=
⟨ λ x, bd_app (bd_app (bd_func ring_binaries.mul) x) ⟩

-- has_pow comes for free by having instances of mul and 1 (see ToMathlib) -- input x ^ n

@[simp] lemma pow_zero {n} (t : bounded_ring_term n) : npow_rec 0 t = 1 := rfl
@[simp] lemma pow_succ {n m} (t : bounded_ring_term m) :
  npow_rec (n + 1) t = t * npow_rec n t := rfl

-- with has_one and has_add you can write any natural and lean will know what term you mean
-- with has_neg you can write any integer etc.

/-
-- variables x0 , x1 in the signature
-- (they are only variables in bounded terms that have up to n + 1, n + 2 variables)
example {n} : bounded_term ring_signature (n + 1) := x_ 0
-- for example {n} : bounded_term ring_signature n := x_ 0 doesn't work
-- since fin n doesn't have an instance of 0 in general (when n = 0)
example {n} : bounded_term ring_signature (n + 2) := x_ 1
-- actually example {n} : bounded_term ring_signature (n + 1) := x_ 1 also works because
-- fin (n + 1) is implemented mod (n + 1), in particular 1 = 0 ∈ fin 1
-- but let's avoid that

-- neg x
example {n} : bounded_ring_term (n + 1) := - (x_ 0)
example {n} : bounded_ring_term (n + 1) := (x_ 0) + 1
example {n} : bounded_ring_term (n + 2):= (- x_ 0) * x_ 1
example {n} : bounded_ring_term (n + 1) := x_ 0 + x_ 0
-/

/-- Part of the definition of ring_term_rec -/
@[simp] def ring_func_rec {n} {C : bounded_term ring_signature n → Sort*}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t)) :
  Π {l : ℕ} (f : ring_signature.functions l) (ts : dvector (bounded_term ring_signature n) l),
  (Π (t : bounded_ring_term n), dvector.pmem t ts → C t)
  → C (bd_apps (bd_func f) ts)
| 0 (ring_consts.zero) ([]) h := c0
| 0 (ring_consts.one) ([]) h := c1
| 1 (ring_unaries.neg) ([t]) h := cneg (h t (psum.inl rfl))
| 2 (ring_binaries.add) ([s,t]) h := cadd (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| 2 (ring_binaries.mul) ([s,t]) h := cmul (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| (n + 3) f ts h := pempty.elim f

/-- An interface for mapping out of bounded_ring_term n (basically bounded_term.rec) -/
def ring_term_rec {n : ℕ} {C : bounded_ring_term n → Sort*}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
  : Π (t : bounded_ring_term n), C t :=
@bounded_term.rec ring_signature n C
(λ k, cvar k)
(λ l, ring_func_rec cvar c0 c1 @cneg @cadd @cmul)

-- def ring_term_ind {n : ℕ} {C : bounded_ring_term n → Prop}
--   (cvar : Π (k : fin n), C (x_ k))
--   (c0 : C 0) (c1 : C 1)
--   (cneg : Π {t}, C t → C (- t))
--   (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
--   : Π (t : bounded_ring_term n), C t :=
-- @bounded_term.rec ring_signature n C
-- (λ k, cvar k)
-- (λ l, ring_func_rec cvar c0 c1 @cneg @cadd @cmul)

/- Sentences for the theory of rings: commutative group under addition -/

/-- Assosiativity of addition -/
def add_assoc : sentence ring_signature :=
  ∀' ∀' ∀' ( (x_ 0 + x_ 1) + x_ 2 ≃ x_ 0 + (x_ 1 + x_ 2) )

/-- Identity for addition -/
def add_id : sentence ring_signature := ∀' ( x_ 0 + 0 ≃ x_ 0 )
-- def add_id : sentence ring_signature := ∀' (   &'0 r+ r0 ≃ &'0   ⊓   r0 r+ &'0 ≃ &'0   )

/-- Inverse for addition -/
def add_inv : sentence ring_signature := ∀' ( - x_ 0 + x_ 0 ≃ 0 )
-- def add_inv : sentence ring_signature := ∀' (  &'0 r+ r- &'0 ≃ r0  ⊓  r- &'0 r+ &'0 ≃ r0  )

/-- Commutativity of addition-/
def add_comm : sentence ring_signature := ∀' ∀' ( x_ 0 + x_ 1 ≃ x_ 1 + x_ 0 )

/- Sentences for theory of rings: commutative monoid under multiplication -/

/-- Associativity of multiplication -/
def mul_assoc : sentence ring_signature :=
∀' ∀' ∀' ( (x_ 0 * x_ 1) * x_ 2 ≃ x_ 0 * (x_ 1 * x_ 2) )

/-- Identity of multiplication -/
def mul_id : sentence ring_signature :=  ∀' ( x_ 0 * 1 ≃ x_ 0 )
-- def mul_id : sentence ring_signature :=  ∀' (   &'0 r× r1 ≃ &'0   )

/-- Commutativity of multiplication -/
def mul_comm : sentence ring_signature := ∀' ∀' ( x_ 0 * x_ 1 ≃ x_ 1 * x_ 0   )

/-- Distributibity -/
def add_mul : sentence ring_signature := ∀' ∀' ∀' ( (x_ 0 + x_ 1) * x_ 2 ≃ x_ 0 * x_ 2 + x_ 1 * x_ 2 )

/-- The theory of rings -/
def ring_theory : Theory ring_signature :=
{add_assoc, add_id, add_inv, add_comm, mul_assoc, mul_id, mul_comm, add_mul}

lemma add_assoc_in_ring_theory : add_assoc ∈ ring_theory :=
begin unfold ring_theory, left, refl end

lemma add_id_in_ring_theory : add_id ∈ ring_theory :=
begin unfold ring_theory, iterate 1 {right}, left, refl end

lemma add_inv_in_ring_theory : add_inv ∈ ring_theory :=
begin unfold ring_theory, iterate 2 {right}, left, refl end

lemma add_comm_in_ring_theory : add_comm ∈ ring_theory :=
begin unfold ring_theory, iterate 3 {right}, left, refl end

lemma mul_assoc_in_ring_theory : mul_assoc ∈ ring_theory :=
begin unfold ring_theory, iterate 4 {right}, left, refl end

lemma mul_id_in_ring_theory : mul_id ∈ ring_theory :=
begin unfold ring_theory, iterate 5 {right}, left, refl end

lemma mul_comm_in_ring_theory : mul_comm ∈ ring_theory :=
begin unfold ring_theory, iterate 6 {right}, left, refl end

lemma add_mul_in_ring_theory : add_mul ∈ ring_theory :=
begin unfold ring_theory, iterate 7 {right}, exact set.mem_singleton _, end

end ring_signature

namespace struc_to_ring_struc
-- We make any (type theoretic) structure A,0,1,-,+,* into a
-- (model theoretic) Structure in ring_signature

variable {A : Type*}

-- Interpreting consant symbols from ring_signature -/
@[simp] def const_map [has_zero A] [has_one A] : ring_consts → (dvector A 0) → A
| ring_consts.zero _ := 0
| ring_consts.one  _ := 1

/-- Interpreting unary function symbols from ring_signature -/
@[simp] def unaries_map [has_neg A] : ring_unaries → (dvector A 1) → A
| ring_unaries.neg a := - (dvector.last a)

/-- Interpreting binary function symbols from ring_signature -/
@[simp] def binaries_map [has_add A] [has_mul A] : ring_binaries → (dvector A 2) → A
| ring_binaries.add   (a :: b) := a + dvector.last b
| ring_binaries.mul  (a :: b) := a * dvector.last b

variables [has_zero A] [has_one A] [has_neg A] [has_add A] [has_mul A]

/-- Interpreting all symbols from ring_signature-/
@[simp] def func_map : Π (n : ℕ), (ring_funcs n) → (dvector A n) → A
| 0       := const_map
| 1       := unaries_map
| 2       := binaries_map
| (n + 3) := pempty.elim

variable (A)

/-- Interpreting the symbols -/
@[reducible] def Structure : Structure ring_signature :=
Structure.mk A func_map (λ n, pempty.elim)

variable {A}

@[simp] lemma realize_zero {n} {vec : dvector A n} :
  @realize_bounded_ring_term (struc_to_ring_struc.Structure A) n vec 0
    (@bd_func ring_signature _ 0 ring_consts.zero) dvector.nil = 0 := rfl

lemma apps_zero {n} : Π {t_ : dvector (bounded_ring_term n) 0},
  bd_apps (@bd_func ring_signature _ 0 ring_consts.zero) t_ = 0
| [] := rfl

@[simp] lemma realize_one {n} {vec : dvector A n} :
  @realize_bounded_ring_term (Structure A) n vec 0
    (@bd_func ring_signature _ 0 ring_consts.one) dvector.nil = 1 := rfl

lemma realize_nat {as} : Π (n : ℕ),
@realize_bounded_term _ (Structure A) _ as _ (n : bounded_ring_term 0) dvector.nil
= n
| 0 := rfl
| (n+1) :=
by simpa only [const_map, realize_bounded_term,
      nat.cast_succ, realize_nat n]

lemma apps_one {n} : Π {t_ : dvector (bounded_ring_term n) 0},
  bd_apps (@bd_func ring_signature _ 0 ring_consts.one) t_ = 1
| [] := rfl

lemma app_neg {n} {t : bounded_ring_term n} :
  bd_app (@bd_func ring_signature _ 1 ring_unaries.neg) t = - t := rfl

lemma apps_neg {n} {t : bounded_ring_term n} :
   bd_apps (@bd_func ring_signature _ 1 ring_unaries.neg) ([t]) = - t := rfl

lemma app_add {n} {s t : bounded_ring_term n} :
  ((@bd_func ring_signature _ 2 ring_binaries.add).bd_app t).bd_app s = t + s := rfl

lemma apps_add {n} {s t : bounded_ring_term n} :
   bd_apps (@bd_func ring_signature _ 2 ring_binaries.add) ([s,t]) = s + t := rfl

lemma app_mul {n} {s t : bounded_ring_term n} :
  ((@bd_func ring_signature _ 2 ring_binaries.mul).bd_app t).bd_app s = t * s := rfl

lemma apps_mul {n} {s t : bounded_ring_term n} :
   bd_apps (@bd_func ring_signature _ 2 ring_binaries.mul) ([s,t]) = s * t := rfl

  -- lemma preterm_upper_bound {n} : bounded_preterm ring_signature n 3 → false := _

end struc_to_ring_struc

namespace comm_ring_to_model

  variables (A : Type*) [comm_ring A]

  lemma realize_ring_theory :
    (struc_to_ring_struc.Structure A) ⊨ ring_signature.ring_theory :=
  begin
    intros ϕ h,
    repeat {cases h},
    { intros a b c,
      simp[add_assoc] },
    { intro a,
      simp },
    { intro a,
      simp },
    { intros a b,
      simp [add_comm] },
    { intros a b c,
      simp [mul_assoc] },
    { intro a,
      simp [mul_one] },
    { intros a b,
      simp [mul_comm] },
    { intros a b c,
      simp [add_mul] }
  end

  /-- Commutative rings model the theory of rings -/
  def model : Model ring_signature.ring_theory :=
  ⟨ struc_to_ring_struc.Structure A ,  realize_ring_theory A ⟩

end comm_ring_to_model

namespace mv_polynomial

  variable {σ : Type}

  open ring_signature

  /-- Terms in the ring_signature are multivariable polynomials over ℤ -/
  noncomputable def term {n} :
    bounded_ring_term n → mv_polynomial (fin n) ℤ :=
  @ring_term_rec n (λ _, mv_polynomial (fin n) ℤ)
    mv_polynomial.X 0 1
    (λ _ p, - p)
    (λ _ _ p q, p + q)
    (λ _ _ p q, p * q)

  @[simp] lemma term_x {n} {k : fin n} : term (x_ k) = mv_polynomial.X k := rfl
  @[simp] lemma term_zero {n} : @term n (bd_func ring_consts.zero) = 0 := rfl
  @[simp] lemma term_one {n} : @term n (bd_func ring_consts.one) = 1 := rfl
  @[simp] lemma term_neg {n} {t : bounded_ring_term n} :
    term (- t) = - term t := rfl
  @[simp] lemma term_add {n} {s t : bounded_ring_term n} :
    term (s + t) = term s + term t := rfl
  @[simp] lemma term_mul {n} {s t : bounded_ring_term n} :
    term (s * t) = term s * term t := rfl

  variables {A : Type*} [comm_ring A]

  @[reducible] private def AStruc := struc_to_ring_struc.Structure A

  /-- terms realized at values in A are the corresponding polynomials -/
  /- evaluated at those values -/
  lemma realized_term_is_evaluated_poly {n} {as : dvector A n} :
  Π (t : bounded_ring_term n),
    @realize_bounded_term _ AStruc _ as _ t dvector.nil
    = mv_polynomial.eval (dvector.fin_val as) (term t) :=
  @ring_term_rec n (λ (t : bounded_ring_term n),
    @realize_bounded_term _ AStruc _ as _ t dvector.nil
      = mv_polynomial.eval (dvector.fin_val as) (term t))
    (begin intro k, simpa, end) -- variables
    (by simpa)
    (by simp)
    (begin -- neg
      intros t h,
      unfold_coes,
      simp only [struc_to_ring_struc.unaries_map, struc_to_ring_struc.func_map,
        dvector.last, realize_bounded_term, dvector.nth, mv_polynomial.coe_mv_poly_neg],
      unfold_coes at h,
      simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
      simp only [term_neg, h, ring_hom.to_fun_eq_coe, ring_hom.map_neg,
        mv_polynomial.eval_map, neg_inj, struc_to_ring_struc.apps_neg],
    end)
    (begin -- add
      intros s t hs ht,
      unfold_coes,
      simp only [term_add, struc_to_ring_struc.binaries_map, dvector.last,
        struc_to_ring_struc.func_map, dvector.last, realize_bounded_term,
        dvector.nth, mv_polynomial.coe_mv_poly_neg, hs, ht],
      unfold_coes,
      simp,
    end)
    (begin -- mul
      intros s t hs ht,
      unfold_coes,
      simp only [term_mul, struc_to_ring_struc.binaries_map, dvector.last,
        struc_to_ring_struc.func_map, dvector.last, realize_bounded_term,
        dvector.nth, mv_polynomial.coe_mv_poly_neg, hs, ht],
      unfold_coes,
      simp,
    end)

end mv_polynomial

namespace polynomial

  variables {A : Type*} [comm_ring A]

  @[reducible] private def AStruc := struc_to_ring_struc.Structure A

  /-- Takes a term in variables x₀ ⋯ xₙ and values a₁ ⋯ aₙ : A and returns
    a polynomial in A[X] such that x₀ ↦ X and otherwise xₙ ↦ aₙ -/
  @[reducible] noncomputable def term_evaluated_at_coeffs {n} (as : dvector A n)
    (t : bounded_ring_term n.succ) : polynomial A :=
  let σ : fin n.succ → polynomial A :=
  @fin.cases n (λ _, polynomial A) polynomial.X (λ i, polynomial.C (dvector.nth' as i)) in
  mv_polynomial.eval σ (mv_polynomial.term t)

  /-- Evaluating the polynomial term_evaluated_at_coeffs at a₀ : A produces the same
    term in A as realising the term at a₀ a₁ ⋯ aₙ -/
  lemma eval_term_evaluated_at_coeffs_eq_realize_bounded_term
    {n} {as : dvector A n} {x : A} (t : bounded_term ring_signature n.succ) :
    (polynomial.eval x (term_evaluated_at_coeffs as t)
      = @realize_bounded_term _ AStruc n.succ (x::as) _ t dvector.nil) :=
  begin
    rw [mv_polynomial.realized_term_is_evaluated_poly,
      dvector.fin_val_eq_x_val,
      mv_polynomial.eval_eq_poly_eval_mv_coeffs],
    simp only [dvector.fin_val, function.comp_app, fin.x_val,
      mv_polynomial.to_polynomial, term_evaluated_at_coeffs],
    unfold_coes,
    have hcoes : int.cast_ring_hom (polynomial A) =
      polynomial.C.comp (int.cast_ring_hom AStruc) := by simp,
    rw hcoes,
    simp,
  end

  lemma term_evaluated_at_coeffs_X {n} {as : dvector A n} :
    term_evaluated_at_coeffs as (x_ ⟨ 0 , nat.zero_lt_succ _ ⟩) = polynomial.X :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_coeff
  {n} {as : dvector A n} {k : fin n} :
    term_evaluated_at_coeffs as (x_ ⟨ k.1.succ , nat.succ_lt_succ k.2 ⟩)
    = polynomial.C (dvector.nth' as k) :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_zero {n} {as : dvector A n} :
    term_evaluated_at_coeffs as (bd_func ring_consts.zero) = 0 :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_one {n} {as : dvector A n} :
    term_evaluated_at_coeffs as (bd_func ring_consts.one) = 1 :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_neg {n} {as : dvector A n} {t : bounded_ring_term n.succ} :
    term_evaluated_at_coeffs as (- t) = - term_evaluated_at_coeffs as t :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_add {n} {as : dvector A n} {s t : bounded_ring_term n.succ} :
    term_evaluated_at_coeffs as (s + t) = term_evaluated_at_coeffs as s + term_evaluated_at_coeffs as t :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_mul {n} {as : dvector A n} {s t : bounded_ring_term n.succ} :
    term_evaluated_at_coeffs as (s * t) = term_evaluated_at_coeffs as s * term_evaluated_at_coeffs as t :=
  begin
    simp only [term_evaluated_at_coeffs],
    unfold_coes,
    simp,
  end

  lemma term_evaluated_at_coeffs_pow {n : ℕ} : Π {m : ℕ} {as : dvector A n},
    polynomial.term_evaluated_at_coeffs as (npow_rec m x_ ⟨ 0 , nat.zero_lt_succ _ ⟩)
    = polynomial.X ^ m
  | 0       _ :=
  by simpa only [ring_signature.pow_zero, term_evaluated_at_coeffs_one]
  | (m + 1) as :=
  by rw [ring_signature.pow_succ, term_evaluated_at_coeffs_mul,
      @term_evaluated_at_coeffs_pow m as, pow_succ, term_evaluated_at_coeffs_X]

  lemma term_evaluated_at_coeffs_monomial {n : ℕ} {m : ℕ} {as : dvector A n} {k : fin n} :
    polynomial.term_evaluated_at_coeffs as
      (x_ ⟨ k.1.succ , nat.succ_lt_succ k.2 ⟩ *
      npow_rec m x_ ⟨ 0 , nat.zero_lt_succ _ ⟩)
      = polynomial.monomial m (dvector.nth' as k) :=
  by rw [term_evaluated_at_coeffs_mul, term_evaluated_at_coeffs_coeff,
     term_evaluated_at_coeffs_pow, polynomial.monomial_eq_C_mul_X]

  lemma term_evaluated_at_coeffs_monomial'
    {n m k : ℕ} {as : dvector A n} (hk : k < n) :
    polynomial.term_evaluated_at_coeffs as
      (x_ ⟨ k.succ , nat.succ_lt_succ hk ⟩ *
      npow_rec m x_ ⟨ 0 , nat.zero_lt_succ _ ⟩)
      = polynomial.monomial m (dvector.nth as k hk) :=
  begin
    rw term_evaluated_at_coeffs_mul,
    have h : term_evaluated_at_coeffs as x_⟨k.succ, _⟩
      =  polynomial.C (dvector.nth as k hk),
    { unfold_coes,
      simp [term_evaluated_at_coeffs, dvector.nth'] },
    rw [h, term_evaluated_at_coeffs_pow, polynomial.monomial_eq_C_mul_X],
  end

  lemma lift_succ_remove_last {n : ℕ} :
  Π {t : bounded_ring_term (n + 1)} {as : dvector A (n + 1)},
    polynomial.term_evaluated_at_coeffs as (lift_succ t)
    = polynomial.term_evaluated_at_coeffs (dvector.remove_mth (n + 2) as) t :=
  @ring_signature.ring_term_rec (n + 1)
  (λ {t : bounded_ring_term (n + 1)}, Π {as : dvector A (n + 1)},
    polynomial.term_evaluated_at_coeffs as (lift_succ t)
    = polynomial.term_evaluated_at_coeffs (dvector.remove_mth (n + 2) as) t)
    (begin -- variables
      intros k as,
      rw lift_succ_x_k,
      cases k with k hk,
      cases k,
      { simp [term_evaluated_at_coeffs] },
      {
        simp only [mv_polynomial.eval_X, polynomial.C_inj,
          fin.coe_eq_cast_succ, fin.cases_succ', mv_polynomial.coe_mv_poly_X,
          fin.cast_succ_mk, mv_polynomial.term_x, term_evaluated_at_coeffs,
          dvector.nth'],
        rw dvector.nth_eq_succ_nth,
      },
    end)
    (by { intro, simp [lift_succ, term_evaluated_at_coeffs_zero] })
    (by { intro, simp [lift_succ, term_evaluated_at_coeffs_one] })
    (by { intros _ h _,
      simp [lift_succ, struc_to_ring_struc.app_neg,
        term_evaluated_at_coeffs_neg, h] })
    (by { intros s t hs ht as,
      simp only [lift_succ, struc_to_ring_struc.app_add,
        term_evaluated_at_coeffs_add, hs, ht] })
    (by { intros s t hs ht as,
      simp only [lift_succ, struc_to_ring_struc.app_mul,
        term_evaluated_at_coeffs_mul, hs, ht] })

end polynomial

namespace models_ring_theory_to_comm_ring

  variable {M : Structure ring_signature}

  def zero : ↥ M := @Structure.fun_map _ M 0 ring_consts.zero dvector.nil
  def one : ↥ M := @Structure.fun_map _ M 0 ring_consts.one dvector.nil
  def neg (a : M.carrier) : M.carrier := @Structure.fun_map _ M 1 ring_unaries.neg ([a])
  def add (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 ring_binaries.add ([a , b])
  def mul (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 ring_binaries.mul ([a , b])

  instance : has_zero M := ⟨ zero ⟩
  instance : has_one M := ⟨ one ⟩
  instance : has_neg M := ⟨ neg ⟩
  instance : has_add M := ⟨ add ⟩
  instance : has_mul M := ⟨ mul ⟩

  @[simp] lemma realize_zero {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (@bd_func ring_signature _ 0 ring_consts.zero) dvector.nil = 0 := rfl

  @[simp] lemma realize_one {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (@bd_func ring_signature _ 0 ring_consts.one) dvector.nil = 1 := rfl

  @[simp] lemma realize_neg {a : M.carrier} :
    @Structure.fun_map _ M 1 ring_unaries.neg ([a]) = - a := rfl

  @[simp] lemma realize_add {a b : M.carrier} :
    @Structure.fun_map _ M 2 ring_binaries.add ([a , b]) = a + b := rfl

  @[simp] lemma realize_mul {a b : M.carrier} :
    @Structure.fun_map _ M 2 ring_binaries.mul ([a , b]) = a * b := rfl

  lemma realize_pow {a : M.carrier} : ∀ {m n} {vec : dvector M.carrier n},
  realize_bounded_term (a :: vec) (npow_rec m (x_ 0)) dvector.nil
  = npow_rec m a
  | 0 n vec := rfl
  | (m+1) n vec :=
  by simp only [npow_rec, realize_bounded_term, realize_mul,
        fin.val_zero, dvector.nth, @realize_pow m]

  lemma realize_nat {M : fol.Structure ring_signature} {as : dvector M 0} :
  Π (n : ℕ),
  @realize_bounded_term _ M _ as _ (n : bounded_ring_term 0) dvector.nil
  = n
  | 0 := rfl
  | (n+1) :=
  by simpa only [realize_bounded_term, nat.cast_succ, realize_nat n, realize_one]

  variable (h : M ⊨ ring_signature.ring_theory)

  include h

  lemma add_assoc (a b c : M) : (a + b) + c = a + (b + c) :=
  begin
    have hAssoc := h ring_signature.add_assoc_in_ring_theory,
    have habc := hAssoc c b a,
    simpa [habc]
  end

  lemma add_comm (a b : M) : a + b = b + a :=
  begin
    have hId := h ring_signature.add_comm_in_ring_theory,
    have hab := hId b a,
    simpa [hab]
  end

  lemma add_zero (a : M) : a + 0 = a :=
  begin
    have hId := h ring_signature.add_id_in_ring_theory,
    have ha := hId a,
    simpa [ha]
  end

  lemma zero_add (a : M) : 0 + a = a :=
  begin
    rw add_comm h, apply add_zero h,
  end

  lemma left_neg (a : M) : - a + a = 0 :=
  begin
    have hInv := h ring_signature.add_inv_in_ring_theory,
    have ha := hInv a,
    simpa [ha]
  end

  lemma mul_assoc (a b c : M) : (a * b) * c = a * (b * c) :=
  begin
    have hAssoc := h ring_signature.mul_assoc_in_ring_theory,
    have habc := hAssoc c b a,
    simpa [habc]
  end

  lemma mul_comm (a b : M) : a * b = b * a :=
  begin
    have hId := h ring_signature.mul_comm_in_ring_theory,
    have hab := hId b a,
    simpa [hab]
  end

  lemma mul_one (a : M) : a * 1 = a :=
  begin
    have hId := h ring_signature.mul_id_in_ring_theory, have ha := hId a, simpa using ha
  end

  lemma one_mul (a : M) : 1 * a = a :=
  by rw [mul_comm h, mul_one h]

  lemma add_mul (a b c : M) : (a + b) * c = a * c + b * c :=
  begin
    have hAM := h ring_signature.add_mul_in_ring_theory,
    have habc := hAM c b a,
    simpa [habc]
  end

  lemma mul_add (c a b : M) : c * (a + b) = c * a + c * b :=
  begin
    rw [mul_comm h c (a + b), mul_comm h c a, mul_comm h c b],
    exact add_mul h a b c,
  end

  instance comm_ring : comm_ring M :=
  {
    add            := add,
    add_assoc      := add_assoc h,
    zero           := zero,
    zero_add       := zero_add h,
    add_zero       := add_zero h,
    neg            := neg,
    add_left_neg   := left_neg h,
    add_comm       := add_comm h,
    mul            := mul,
    mul_assoc      := mul_assoc h,
    one            := one,
    one_mul        := one_mul h,
    mul_one        := mul_one h,
    left_distrib   := mul_add h,
    right_distrib  := add_mul h,
    mul_comm       := mul_comm h,
  }

end models_ring_theory_to_comm_ring

namespace instances

open ulift

def pℕ : Type* := ulift ℕ

def nat_ring_consts :
  ring_consts → dvector pℕ 0 → pℕ
| ring_consts.zero as := up 0
| ring_consts.one as := up 1

def nat_ring_structure_funcs :
  Π {n}, ring_signature.functions n → dvector pℕ n → pℕ
| 0 ring_consts.zero as := up 0
| 0 ring_consts.one as := up 1
| 1 ring_unaries.neg as := up 0
| 2 ring_binaries.add (dvector.cons a (dvector.cons b nil)) :=
  up ( down a + down b)
| 2 ring_binaries.mul (dvector.cons a (dvector.cons b nil)) :=
  up ( down a * down b)
| (n+3) f as := pempty.elim f

def nat_ring_structure : fol.Structure ring_signature :=
⟨ pℕ , λ _, nat_ring_structure_funcs , λ _, pempty.elim ⟩

lemma nat_ring_structure_realize_nat :
  Π (n : ℕ) {k : ℕ} (v : dvector nat_ring_structure k),
  realize_bounded_ring_term v
    (n : fol.bounded_preterm ring_signature k 0) dvector.nil = up n
| 0 _ _ := rfl
| (n+1) k v :=
begin
  have h := @nat_ring_structure_realize_nat n k v,
  rw [realize_bounded_ring_term] at h,
  simpa only [nat.cast_succ, realize_bounded_ring_term,
    fol.realize_bounded_term, h],
end

lemma nat_cast_bd_ring_term_inj {k n m : ℕ} :
  (n : fol.bounded_preterm ring_signature.{u} k 0) = m → n = m :=
begin
  let v : dvector nat_ring_structure k := dvector.of_fn (λ i, 0),
  intro hnm,
  rw [← down_up n, ← down_up m, ← nat_ring_structure_realize_nat n v,
    ← nat_ring_structure_realize_nat m v],
  apply congr_arg down.{u},
  exact @congr_arg (fol.bounded_preterm ring_signature k 0)
    nat_ring_structure n m
    (λ t : fol.bounded_preterm ring_signature k 0,
      realize_bounded_ring_term v t dvector.nil) hnm,
end

end instances

end Rings


noncomputable
def Quot.repr {S : α → α → Prop} (a : Quot S) : α := Classical.choose a.exists_rep

namespace SciLean

  abbrev Rel (α : Type u) := α → α → Prop

  class IsQHom (S : Rel α) (R : Rel β) (f : α → β) where
    is_hom : ∀ a a', S a a' → R (f a) (f a')

  class IsQHom₂ (S : Rel α) (R : Rel β) (T : Rel γ) (f : α → β → γ) where
    is_hom : ∀ a a' b b', S a a' → R b b' → T (f a b) (f a' b')

  notation "⟦" x "⟧" => Quot.mk _ x
  notation "⟦" x ", " S "⟧" => Quot.mk S x

  def IsQHom.sound {S : Rel α} {R : Rel β} (f : α → β) [IsQHom S R f]
    : ∀ a a', S a a' → ⟦f a⟧ = ⟦f a', R⟧
    :=
  by
    intros a a' h;
    apply Quot.sound;
    apply IsQHom.is_hom a a' h
    done

  def IsQHom₂.sound {S : Rel α} {R : Rel β} {T : Rel γ} (f : α → β → γ) [IsQHom₂ S R T f]
    : ∀ a a' b b', S a a' → R b b' → ⟦f a b⟧ = ⟦f a' b', T⟧
    :=
  by
    intros a a' b b' h h';
    apply Quot.sound;
    apply IsQHom₂.is_hom a a' b b' h h'
    done

  notation "⟦" f "⟧" => Quot.lift (λ x => Quot.mk _ (f x)) (IsQHom.sound f)
  notation "⟦" f ", " S ", " R"⟧" => Quot.lift (r := S) (λ x => Quot.mk R (f x)) (IsQHom.sound f)

  instance : Coe α (Quot (Eq : α → α → Prop)) :=
  ⟨ λ a => Quot.mk _ a ⟩

  -- This one seem to be dangerous :(
  -- instance : Coe (Quot (Eq : α → α → Prop)) α :=
  -- ⟨ λ a => Quot.lift id (by intro a b h; apply h; done) a ⟩

  ---------------------

  instance (f : α → β) : IsQHom Eq Eq f := sorry

  instance (S : Rel α) : IsQHom S S (λ x => x) := sorry

  instance (S : Rel α) (R : Rel β) (T : Rel γ)
    (f : β → γ) (g : α → β)
    [IsQHom R T f] [IsQHom S R g]
    : IsQHom S T (f ∘ g)
    := sorry

  ---------------------

  @[simp]
  theorem quot_comp
    (S : Rel α) (R : Rel β) (T : Rel γ)
    (f : β → γ) (g : α → β) [IsQHom R T f] [IsQHom S R g]
    :
    ⟦f, R, T⟧ ∘ ⟦g, S, R⟧ = ⟦f ∘ g, S, T⟧
    :=
    sorry

  @[simp]
  theorem quot_apply {S : Rel α} {R : Rel β} (f : α → β) [IsQHom S R f] (a : Quot S)
    : ⟦f a.repr, R⟧ = ⟦f⟧ a
    := sorry

  ---------------------

  variable {f : α → β} {S : Rel α} {R : Rel β} {a : α} [IsQHom S R f]

  #check Eq

  #check ⟦f, Eq, Eq⟧ ⟦a, Eq⟧
  #check ⟦f, Eq, Eq⟧ ⟦a⟧
  #check ⟦f, Eq, Eq⟧ a

  #check ⟦f, S, R⟧ ⟦a, S⟧
  #check ⟦f, S, R⟧ ⟦a⟧

  #check ⟦f, S, R⟧
  #check (⟦f⟧ ⟦a⟧ : Quot R)

  -- ⟦f⟧ ∘ ⟦g⟧ = ⟦f ∘ g⟧
  -- ⟦f x.repr⟧ = ⟦f⟧ x
  -- ⟦f⟧ ⟦x⟧ = ⟦f x⟧

end SciLean


universe u

class ordinal (α : Type u) extends
  decidable_linear_order α, has_zero α, has_add α, has_mul α :=
(omega : α)
(succ : α → α)
(zero_le : ∀ x : α, 0 ≤ x)
(zero_lt_omega : 0 < omega)
(zero_or_succ_of_lt_omega : ∀ x : α, x < omega → (x = 0 ∨ ∃ y, x = succ y))
(succ_ne_zero : ∀ x : α, succ x ≠ 0)
(succ_ne_omega : ∀ x : α, succ x ≠ omega)
(lt_succ : ∀ x : α, x < succ x)
(le_of_lt_succ : ∀ {x y : α}, x < succ y → x ≤ y)
(add_zero : ∀ x : α, x + 0 = x)
(add_limit_le : ∀ {x y z : α}, y ≠ 0 → (∀ w : α, w < y → x + w < z) → x + y ≤ z)
(add_limit_gt : ∀ {x y z u : α}, u < y → x + u < z → x + y ≤ z)
(add_lt_add_left : ∀ {x y : α}, x < y → ∀ z, z + x < z + y)
(mul_zero : ∀ x : α, x * 0 = 0)
(mul_succ : ∀ x y : α, x * succ y = x * y + x)
(mul_limit : ∀ {x y z : α}, y ≠ 0 → (∀ w : α, w < y → x * y < z) → x * y ≤ z)
(transfinite_induction : ∀ (x: α) (φ : α → Prop), (∀ y : α, (∀ z : α, z < y → φ z) → φ y) → φ x)

lemma lt_of_lt_of_lt {α : Type u} [preorder α] :
∀ {a b c : α}, a < b → b < c → a < c
| a b c hab hbc := lt_of_lt_of_le hab $ le_of_lt hbc

namespace ordinal

variables {α : Type u} [ordinal α] {x y z u : α}

def ω := omega α

instance : has_one α := ⟨succ 0⟩

theorem lt_succ_of_le : x ≤ y → x < succ y
| hxy := lt_of_le_of_lt hxy $ lt_succ y

theorem le_iff_lt_succ : x ≤ y ↔ x < succ y :=
⟨lt_succ_of_le, le_of_lt_succ⟩

theorem lt_of_succ_le : succ y ≤ x → y < x
| hyx := lt_of_lt_of_le (lt_succ y) hyx

theorem succ_le_of_lt : y < x → succ y ≤ x
| hyx := le_of_not_gt $ λ hxy, not_le_of_gt hyx $ le_of_lt_succ hxy

theorem lt_iff_succ_le : y < x ↔ succ y ≤ x :=
⟨succ_le_of_lt, lt_of_succ_le⟩

theorem succ_lt : x < y → succ x < succ y
| hxy := lt_succ_of_le $ succ_le_of_lt hxy

theorem succ_le : x ≤ y → succ x ≤ succ y
| hxy := succ_le_of_lt $ lt_succ_of_le hxy

theorem lt_of_succ_lt : succ x < succ y → x < y
| hxy := lt_of_succ_le $ le_of_lt_succ hxy

theorem le_of_succ_le : succ x ≤ succ y → x ≤ y
| hxy := le_of_lt_succ $ lt_of_succ_le hxy

theorem succ_inj : succ x = succ y → x = y
| hxy := le_antisymm
         (le_of_succ_le $ le_of_eq hxy)
         (le_of_succ_le $ le_of_eq hxy.symm)

theorem succ_lt_of_lt_of_limit : (∀ w, succ w ≠ x) → y < x → succ y < x
| hx hyx := lt_of_le_of_ne (le_of_lt_succ $ succ_lt hyx) $ hx y

theorem add_succ : x + succ y = succ (x + y) :=
begin
  apply transfinite_induction y,
  intros z hy,
  apply le_antisymm,
  apply add_limit_le,
  exact succ_ne_zero z,
  intros w hwz,
  cases lt_or_eq_of_le (le_of_lt_succ hwz),
  apply lt_of_lt_of_lt (add_lt_add_left a x),
  apply lt_succ,
  rw a,
  apply lt_succ,
  apply le_of_lt_succ,
  apply succ_lt,
  apply add_lt_add_left,
  exact lt_succ z
end

theorem add_le_add_right : x < y → x + z ≤ y + z :=
begin
  intro hxy,
  apply transfinite_induction z,
  intros z' hz',
  cases decidable_linear_order.decidable_eq α z' 0,
  apply add_limit_le a,
  intros w hwz',
  apply lt_of_le_of_lt,
  exact hz' w hwz',
  exact add_lt_add_left hwz' y,
  rw [a,add_zero,add_zero],
  exact le_of_lt hxy
end

theorem zero_add : 0 + x = x :=
begin
  apply transfinite_induction x,
  intros y hy,
  cases decidable_linear_order.decidable_eq α y 0,
  apply le_antisymm,
  apply add_limit_le,
  exact a,
  intros w hwy,
  rw hy w, exact hwy, exact hwy,
  apply le_of_not_gt,
  intro hy2,
  apply ne_of_lt (add_lt_add_left hy2 0),
  apply hy _ hy2,
  rw a, exact add_zero 0
end

theorem one_add : x ≤ 1 + x :=
@transfinite_induction α _ x (λ x, x ≤ 1 + x) $ λ y hy,
le_of_not_gt $ λ hy2, not_le_of_gt (add_lt_add_left hy2 1) (hy _ hy2)

theorem one_add_eq_succ_of_lt_omega : x < ω → 1 + x = succ x :=
begin
  apply transfinite_induction x (λ x, x < ω → 1 + x = succ x),
  intros y hy,
  intro hyω,
  cases zero_or_succ_of_lt_omega _ hyω,
  rw [a,add_zero], unfold has_one.one,
  cases a,
  rw [a_1,add_succ],
  apply congr_arg,
  apply hy,
  rw a_1,
  apply lt_succ,
  apply lt_of_lt_of_lt,
  apply lt_succ,
  rw ←a_1,
  exact hyω
end

theorem one_add_omega : (1:α) + ω = ω :=
begin
  apply le_antisymm,
  apply add_limit_le,
  apply ne_of_gt,
  exact zero_lt_omega α,
  intro w,
  apply transfinite_induction w (λ w, w < ω → 1 + w < ω),
  intros y hy hyω,
  cases zero_or_succ_of_lt_omega _ hyω,
  rw [a,add_zero],
  apply succ_lt_of_lt_of_limit succ_ne_omega,
  apply zero_lt_omega α,
  cases a,
  rw [a_1,add_succ],
  apply succ_lt_of_lt_of_limit succ_ne_omega,
  rw one_add_eq_succ_of_lt_omega,
  rw ←a_1, apply hyω,
  apply lt_of_lt_of_lt,
  apply lt_succ,
  rw ←a_1,
  exact hyω,
  apply one_add
end

end ordinal


import category_theory.category.default
import game.world1.level4

universes v u  -- The order in this declaration matters: v often needs to be explicitly specified while u often can be omitted

namespace category_theory

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

/-
# Category world

## Level 5: More tactic reviews
-/

/-blah blah

-/

/- Lemma
If $$f : X ⟶ Y$$ and $$g : X ⟶ Y$$ are morphisms such that $$f = g$$, then $$f ≫ h = g ≫ h$$.
-/
lemma id_of_comp_right_id' (X : C) (f : X ⟶ X) (w : ∀ {Y : C} (g : Y ⟶ X), g ≫ f = g) : f = 𝟙 X :=
begin
    apply eq_of_comp_right_eq'',
    intros Z h,
    rw category.comp_id h,
    apply w,
end

end category_theory


import analysis.normed_space.exponential
import analysis.specific_limits.normed
import analysis.special_functions.exponential
import data.complex.exponential
import probability.probability_mass_function.basic

namespace pmf

noncomputable theory

open nat
open_locale classical big_operators nnreal ennreal

def bernoulli (p : ℝ≥0∞) (h : p ≤ 1) : pmf bool :=
⟨λ b, cond b p (1 - p), by simp [summable.has_sum_iff, tsum_bool, add_comm, h]⟩

example (f : ℝ → ℝ) (h : ∀ a, 0 ≤ f a) (h' : summable (λ (a : ℝ), f a)):
∑' (a : ℝ), ennreal.of_real (f a) = ennreal.of_real ∑' (a : ℝ), f a :=
begin
  exact (ennreal.of_real_tsum_of_nonneg h h').symm,
end

example {l : ℝ} : ∑' (n : ℕ), l ^ n / ↑(n.factorial) = real.exp l :=
begin
  rw [real.exp_eq_exp_ℝ, exp_eq_tsum_div],
end

def poisson (l : ℝ) (h : 0 < l) : pmf ℕ :=
⟨ λ k, ennreal.of_real $ (real.exp $ -l) * ((l : ℝ) ^ k) / factorial k,
  by { simp [summable.has_sum_iff],
    rw ← ennreal.of_real_tsum_of_nonneg,
    { rw [show 1 = ennreal.of_real (real.exp (-l) * real.exp l),
          by rw [real.exp_eq_exp_ℝ, ← exp_add, neg_add_self, exp_zero, ennreal.of_real_one]],
      congr,
      suffices : ∑' (n : ℕ), (λ k, l ^ k / ↑(factorial k)) n * real.exp (-l)
                 = real.exp (-l) * real.exp l,
      { rw ← this, congr, funext, ring_nf, },
      rw [mul_comm],
      simp_rw [← smul_eq_mul],
      rw [tsum_smul_const, real.exp_eq_exp_ℝ, exp_eq_tsum_div],
      exact exp_series_div_summable ℝ l, },
    { intro n,
      apply div_nonneg,
      apply mul_nonneg,
      exact le_of_lt (real.exp_pos _),
      exact pow_nonneg (le_of_lt h) n,
      rw ← cast_zero,
      exact cast_le.2 (le_of_lt (factorial_pos n)), },
    { have : summable (λ (n : ℕ), real.exp (-l) • (λ i, l ^ i / ↑(factorial i)) n),
      { apply summable.const_smul, simp [real.summable_pow_div_factorial l], },
      simp at this,
      simp_rw [← mul_div, this], }, }⟩

end pmf


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.sheaf_condition.sites
import category_theory.sites.limits
import category_theory.adjunction
import category_theory.limits.functor_category

/-!
# Presheaves in `C` have limits and colimits when `C` does.
-/

noncomputable theory

universes v u

open category_theory
open category_theory.limits

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

namespace Top

instance [has_limits C] (X : Top) : has_limits (presheaf C X) :=
limits.functor_category_has_limits_of_size.{v v}

instance [has_colimits C] (X : Top) : has_colimits_of_size.{v} (presheaf C X) :=
limits.functor_category_has_colimits_of_size

instance [has_limits C] (X : Top) : creates_limits (sheaf.forget C X) :=
(@@creates_limits_of_nat_iso _ _
  (presheaf.Sheaf_spaces_equiv_sheaf_sites_inverse_forget C X))
  (@@category_theory.comp_creates_limits _ _ _ _ _ _
    Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{u v v})

instance [has_limits C] (X : Top) : has_limits_of_size.{v} (sheaf.{v} C X) :=
has_limits_of_has_limits_creates_limits (sheaf.forget C X)

lemma is_sheaf_of_is_limit [has_limits C] {X : Top} (F : J ⥤ presheaf.{v} C X)
  (H : ∀ j, (F.obj j).is_sheaf) {c : cone F} (hc : is_limit c) : c.X.is_sheaf :=
begin
  let F' : J ⥤ sheaf C X := { obj := λ j, ⟨F.obj j, H j⟩, map := F.map },
  let e : F' ⋙ sheaf.forget C X ≅ F := nat_iso.of_components (λ _, iso.refl _) (by tidy),
  exact presheaf.is_sheaf_of_iso ((is_limit_of_preserves (sheaf.forget C X)
      (limit.is_limit F')).cone_points_iso_of_nat_iso hc e) (limit F').2
end

lemma limit_is_sheaf [has_limits C] {X : Top} (F : J ⥤ presheaf.{v} C X)
  (H : ∀ j, (F.obj j).is_sheaf) : (limit F).is_sheaf :=
is_sheaf_of_is_limit F H (limit.is_limit F)

end Top


import defs.dynamics
import defs.statics

theorem bool_canonical_forms
  {Γ: env} {e: exp} (value: val e)
  (et: has_typ Γ e typ.bool)
  : e = exp.true ∨ e = exp.false :=
begin
  cases value,
  repeat {cases et},
  left,
  refl,
  right,
  refl,
end

theorem arrow_canonical_forms
  {Γ: env} {e: exp} {τ1 τ2: typ} (value: val e)
  (et: has_typ Γ e (typ.arrow τ1 τ2))
  : ∃ (x: var) (e': exp), e = exp.fn x τ1 e' :=
begin
  cases value,
  repeat {cases et},
  existsi [value_x, value_e],
  refl,
end

theorem pair_canonical_forms
  {Γ: env} {e: exp} {τ1 τ2: typ} (value: val e)
  (et: has_typ Γ e (typ.pair τ1 τ2))
  : ∃ (e1 e2: exp), e = exp.pair e1 e2 :=
begin
  cases value,
  repeat {cases et},
  existsi [value_e1, value_e2],
  refl,
end

theorem never_canonical_forms
  {Γ: env} {e: exp} (value: val e)
  (et: has_typ Γ e typ.never)
  : false :=
begin
  cases value,
  repeat {cases et},
end

theorem either_canonical_forms
  {Γ: env} {e: exp} {τ1 τ2: typ} (value: val e)
  (et: has_typ Γ e (typ.either τ1 τ2))
  : ∃ (e': exp), (e = exp.either_left τ2 e') ∨ (e = exp.either_right τ1 e') :=
begin
  cases value,
  repeat {cases et},
  existsi value_e,
  left,
  refl,
  existsi value_e,
  right,
  refl,
end