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) := ⟨ zero ⟩
@[reducible] instance bounded_ring_term_has_zero' {n} : has_zero (bounded_ring_term' n) := ⟨ 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) := ⟨ one ⟩
@[reducible] instance bounded_ring_term_has_one' {n} : has_one (bounded_ring_term' n) := ⟨ 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) := ⟨ neg ⟩
@[reducible] instance bounded_ring_term_has_neg' {n} : has_neg (bounded_ring_term' n) := ⟨ 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) := ⟨ add ⟩
@[reducible] instance bounded_ring_term_has_add' {n} : has_add (bounded_ring_term'  n) := ⟨ add ⟩

@[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) := ⟨ mul ⟩
@[reducible] instance bounded_ring_term_has_mul' {n} : has_mul (bounded_ring_term' n) := ⟨ mul ⟩

-- 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 [ring_signature.add, 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 only [struc_to_ring_struc.func_map, fin.val_zero', struc_to_ring_struc.binaries_map,
        dvector.last,
        realize_bounded_formula, realize_bounded_term, fin.val_two, fin.val_one, dvector.nth],
      apply add_assoc
    },
    {
      intro a,
      simp,-- simp only [add_zero, struc_to_ring_struc.func_map, fin.val_zero',
      --   struc_to_ring_struc.binaries_map, realize_bounded_ring_term,
      --   dvector.last, eq_self_iff_true, realize_bounded_term_bd_app, realize_bounded_formula,
      --   realize_bounded_term, struc_to_ring_struc.realize_zero, dvector.nth,
      --   ring_signature.zero, ring_signature.add],
    },
    {
      intro a,
      simp,
      -- simp only [struc_to_ring_struc.func_map, fin.val_zero', struc_to_ring_struc.binaries_map,
      --   struc_to_ring_struc.unaries_map, dvector.last, eq_self_iff_true, realize_bounded_term_bd_app,
      --   realize_bounded_formula, realize_bounded_term, struc_to_ring_struc.realize_zero,
      --   dvector.nth, ring_signature.zero, ring_signature.neg, ring_signature.add, add_left_neg],
    },
    {
      intros a b,
      simp only [struc_to_ring_struc.func_map, fin.val_zero', struc_to_ring_struc.binaries_map,
        dvector.last, realize_bounded_formula, ring_signature.add,
        realize_bounded_term, fin.val_one, dvector.nth, add_comm]
    },
    {
      intros a b c,
      simp only [ring_signature.mul,
        struc_to_ring_struc.func_map, fin.val_zero', struc_to_ring_struc.binaries_map,
        dvector.last, realize_bounded_formula,
        realize_bounded_term, fin.val_two, fin.val_one, dvector.nth, mul_assoc],
    },
    {
      intro a,
      simp only [ring_signature.mul, struc_to_ring_struc.realize_one,
        struc_to_ring_struc.func_map, fin.val_zero',
        struc_to_ring_struc.const_map, mul_one, struc_to_ring_struc.binaries_map,
        dvector.last, eq_self_iff_true, ring_signature.one,
        realize_bounded_term_bd_app, realize_bounded_formula, realize_bounded_term, dvector.nth],
    },
    {
      intros a b,
      simp only [ring_signature.mul, struc_to_ring_struc.func_map,
        fin.val_zero', struc_to_ring_struc.binaries_map,
        dvector.last, realize_bounded_formula,
        realize_bounded_term, fin.val_one, dvector.nth, mul_comm],
    },
    {
      intros a b c,
      simp only [ring_signature.mul, struc_to_ring_struc.func_map,
        fin.val_zero', struc_to_ring_struc.binaries_map, dvector.last,
        realize_bounded_formula, realize_bounded_term, fin.val_two,
        fin.val_one, dvector.nth, add_mul, ring_signature.add]
    }
  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
    (begin -- zero
      simpa only [struc_to_ring_struc.apps_zero, dvector.fin_val, realize_bounded_term,
        struc_to_ring_struc.realize_zero, term_zero, zero],
    end)
    (by simp)
    -- simp only [struc_to_ring_struc.apps_one, dvector.fin_val, realize_bounded_term,
    --   struc_to_ring_struc.realize_one, term_one, one,
    --   mv_polynomial.coe_mv_poly_one, ring_hom.map_one],
    (begin -- neg
      intros t h,
      unfold_coes,
      unfold_coes at h,
      simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
      rw term_neg,
      simp only [struc_to_ring_struc.unaries_map, struc_to_ring_struc.func_map,
        dvector.last, realize_bounded_term, neg, dvector.nth, mv_polynomial.coe_mv_poly_neg],
      rw h,
      simp only [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,
      rw term_add,
      simp only [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],
      rw [hs, ht],
      unfold_coes,
      simp,
    end)
    (begin -- mul
      intros s t hs ht,
      unfold_coes,
      rw term_mul,
      simp only [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],
      rw [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,
    rw dvector.fin_val_eq_x_val,
    rw 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],
    have hcoes : polynomial.C.comp (int.cast_ring_hom AStruc) = int.cast_ring_hom (polynomial A) :=
    by simp,
    unfold_coes,
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_x],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_x],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_zero],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_one],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_neg],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_add],
    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 only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.term_mul],
    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       _ :=
  begin
    rw ring_signature.pow_zero,
    simp only [ring_signature.one, term_evaluated_at_coeffs_one],
    refl,
  end
  | (m + 1) as :=
  begin
    rw [ring_signature.pow_succ,
      term_evaluated_at_coeffs_mul,
      @term_evaluated_at_coeffs_pow m as,
      pow_succ,
      term_evaluated_at_coeffs_X],
  end

  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) :=
  begin
    rw term_evaluated_at_coeffs_mul,
    rw term_evaluated_at_coeffs_coeff,
    rw term_evaluated_at_coeffs_pow,
    rw polynomial.monomial_eq_C_mul_X,
  end

  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),
    {
      simp only [term_evaluated_at_coeffs],
      unfold_coes,
      simp only [mv_polynomial.eval_map,
        mv_polynomial.term_x, mv_polynomial.eval_X, polynomial.C_inj,
        ring_hom.to_fun_eq_coe, fin.cases_succ', mv_polynomial.map_X,
        dvector.nth'],
    },
    rw h,
    rw term_evaluated_at_coeffs_pow,
    rw 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 only [mv_polynomial.eval_X, fin.mk_zero, fin.cases_zero, fin.coe_eq_cast_succ,
        fin.cast_succ_zero, mv_polynomial.coe_mv_poly_X,
        mv_polynomial.term_x, 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'],
        apply dvector.nth_eq_succ_nth,
      },
    end)
    (begin -- 0
      intro as,
      simp only [ring_signature.zero, lift_succ],
      repeat {rw term_evaluated_at_coeffs_zero},
    end)
    (begin -- 1
      intro as,
      simp only [ring_signature.one, lift_succ],
      repeat {rw term_evaluated_at_coeffs_one},
    end)
    (begin -- neg
      intros t h as,
      simp only [ring_signature.neg, lift_succ],
      repeat {rw struc_to_ring_struc.app_neg},
      repeat {rw term_evaluated_at_coeffs_neg},
      rw h,
    end)
    (begin -- add
      intros s t hs ht as,
      simp only [ring_signature.add, lift_succ],
      repeat {rw struc_to_ring_struc.app_add},
      repeat {rw term_evaluated_at_coeffs_add},
      rw [hs, ht],
    end)
    (begin -- mul
      intros s t hs ht as,
      simp only [ring_signature.mul, lift_succ],
      repeat {rw struc_to_ring_struc.app_mul},
      repeat {rw term_evaluated_at_coeffs_mul},
      rw [hs, ht],
    end)

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, ring_signature.mul, 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 [ring_signature.add, ring_signature.one, 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 using 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 using 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 using 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 using 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 using 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 using 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 :=
  begin
    rw mul_comm h, apply mul_one h
  end

  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 using habc
  end

  lemma mul_add (c a b : M) : c * (a + b) = c * a + c * b :=
  begin
    rw (mul_comm h c (a + b)), rw (mul_comm h c a), rw (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 importing_model_theory_results

-- /- I am interested in showing that a ring has a property
--  using model theory tech.
--  i.e. to use the model theory tech I need to show that
--  A ≃+* comm_ring_to_model.model A -/

-- variables (A : Type*) [comm_ring A]

-- lemma structure_eq_carrier : A = struc_to_ring_struc.Structure A := rfl

-- -- example : has_one (struc_to_ring_struc.Structure A) := by apply_instance

-- -- need to check how this works with inj -> surj thing

-- end importing_model_theory_results

-- section ulift

-- def ulift_Structure.carrier (S : Structure.{0} ring_signature) : Type u :=
--   ulift S.carrier

-- def ring_signature_functions_ulift_down : Π {n},
--   Rings.ring_signature.{u}.functions n → Rings.ring_signature.{0}.functions n
-- | 0 ring_consts.zero := ring_consts.zero
-- | 0 ring_consts.one := ring_consts.one
-- | 1 ring_unaries.neg := ring_unaries.neg
-- | 2 ring_binaries.add := ring_binaries.add
-- | 2 ring_binaries.mul := ring_binaries.mul
-- | (n + 3) f := pempty.elim f

-- def ulift_Structure (S : Structure.{0} ring_signature) :
--   Structure.{u} ring_signature :=
-- ⟨ ulift_Structure.carrier S ,
--   (λ n f as , ulift.up $
--     S.fun_map (ring_signature_functions_ulift_down f) (dvector.ulift_down as)),
--   λ n, pempty.elim ⟩

-- def ulift_down

-- def ulift_down_Theory {T : Theory.{u} ring_signature} : Theory.{0} ring_signature :=
-- sorry

-- variable {S : Structure.{0} ring_signature}

-- lemma ulift_Structure_realize_sentence {ϕ : sentence ring_signature} :
--   ulift_Structure S ⊨ ϕ ↔ S ⊨ ϕ := sorry

-- lemma ulift_Structure_all_realize_sentence {T : Theory ring_signature} :
--   ulift_Structure.{u} S ⊨ T ↔ S ⊨ T :=
-- begin
--   split,
--   {
--     intros hST ϕ hϕ,
--     rw ← ulift_Structure_realize_sentence,
--     exact hST hϕ,
--   },
--   {
--     intros hST ϕ hϕ,
--     rw ulift_Structure_realize_sentence,
--     exact hST hϕ,
--   },
-- end

-- #check ulift_Structure_realize_sentence

-- end ulift

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, ring_signature.add, 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,
  rw ← down_up m,
  apply congr_arg down.{u},
  rw ← nat_ring_structure_realize_nat n v,
  rw ← nat_ring_structure_realize_nat m v,
  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


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.induction
import Mathlib.data.polynomial.degree.definitions
import Mathlib.deprecated.ring
import Mathlib.PostPort

universes u v u_1 u_2 w y

namespace Mathlib

/-!
# Theory of univariate polynomials

The main defs here are `eval₂`, `eval`, and `map`.
We give several lemmas about their interaction with each other and with module operations.
-/

namespace polynomial

/-- Evaluate a polynomial `p` given a ring hom `f` from the scalar ring
  to the target and a value `x` for the variable in the target -/
def eval₂ {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) (p : polynomial R) : S :=
  finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e

theorem eval₂_eq_sum {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] {f : R →+* S} {x : S} : eval₂ f x p = finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e :=
  rfl

theorem eval₂_eq_lift_nc {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {x : S} : eval₂ f x = ⇑(add_monoid_algebra.lift_nc (↑f) (coe_fn (powers_hom S) x)) :=
  rfl

theorem eval₂_congr {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] {f : R →+* S} {g : R →+* S} {s : S} {t : S} {φ : polynomial R} {ψ : polynomial R} : f = g → s = t → φ = ψ → eval₂ f s φ = eval₂ g t ψ :=
  fun (ᾰ : f = g) (ᾰ_1 : s = t) (ᾰ_2 : φ = ψ) => Eq._oldrec (Eq._oldrec (Eq._oldrec (Eq.refl (eval₂ f s φ)) ᾰ_2) ᾰ_1) ᾰ

@[simp] theorem eval₂_zero {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) : eval₂ f x 0 = 0 :=
  finsupp.sum_zero_index

@[simp] theorem eval₂_C {R : Type u} {S : Type v} {a : R} [semiring R] [semiring S] (f : R →+* S) (x : S) : eval₂ f x (coe_fn C a) = coe_fn f a := sorry

@[simp] theorem eval₂_X {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) : eval₂ f x X = x := sorry

@[simp] theorem eval₂_monomial {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) {n : ℕ} {r : R} : eval₂ f x (coe_fn (monomial n) r) = coe_fn f r * x ^ n := sorry

@[simp] theorem eval₂_X_pow {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) {n : ℕ} : eval₂ f x (X ^ n) = x ^ n := sorry

@[simp] theorem eval₂_add {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval₂ f x (p + q) = eval₂ f x p + eval₂ f x q := sorry

@[simp] theorem eval₂_one {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) : eval₂ f x 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x 1 = 1)) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (coe_fn C 1) = 1)) (eval₂_C f x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f 1 = 1)) (ring_hom.map_one f))) (Eq.refl 1)))

@[simp] theorem eval₂_bit0 {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval₂ f x (bit0 p) = bit0 (eval₂ f x p) := sorry

@[simp] theorem eval₂_bit1 {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval₂ f x (bit1 p) = bit1 (eval₂ f x p) := sorry

@[simp] theorem eval₂_smul {R : Type u} {S : Type v} [semiring R] [semiring S] (g : R →+* S) (p : polynomial R) (x : S) {s : R} : eval₂ g x (s • p) = coe_fn g s • eval₂ g x p := sorry

@[simp] theorem eval₂_C_X {R : Type u} [semiring R] {p : polynomial R} : eval₂ C X p = p := sorry

protected instance eval₂.is_add_monoid_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) : is_add_monoid_hom (eval₂ f x) :=
  is_add_monoid_hom.mk (eval₂_zero f x)

@[simp] theorem eval₂_nat_cast {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) (n : ℕ) : eval₂ f x ↑n = ↑n := sorry

theorem eval₂_sum {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] (f : R →+* S) [semiring T] (p : polynomial T) (g : ℕ → T → polynomial R) (x : S) : eval₂ f x (finsupp.sum p g) = finsupp.sum p fun (n : ℕ) (a : T) => eval₂ f x (g n a) := sorry

theorem eval₂_finset_sum {R : Type u} {S : Type v} {ι : Type y} [semiring R] [semiring S] (f : R →+* S) (s : finset ι) (g : ι → polynomial R) (x : S) : eval₂ f x (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => eval₂ f x (g i) := sorry

theorem eval₂_mul_noncomm {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R} [semiring S] (f : R →+* S) (x : S) (hf : ∀ (k : ℕ), commute (coe_fn f (coeff q k)) x) : eval₂ f x (p * q) = eval₂ f x p * eval₂ f x q := sorry

@[simp] theorem eval₂_mul_X {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval₂ f x (p * X) = eval₂ f x p * x := sorry

@[simp] theorem eval₂_X_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval₂ f x (X * p) = eval₂ f x p * x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (X * p) = eval₂ f x p * x)) X_mul))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * X) = eval₂ f x p * x)) (eval₂_mul_X f x)))
      (Eq.refl (eval₂ f x p * x)))

theorem eval₂_mul_C' {R : Type u} {S : Type v} {a : R} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) (h : commute (coe_fn f a) x) : eval₂ f x (p * coe_fn C a) = eval₂ f x p * coe_fn f a := sorry

theorem eval₂_list_prod_noncomm {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) (ps : List (polynomial R)) (hf : ∀ (p : polynomial R), p ∈ ps → ∀ (k : ℕ), commute (coe_fn f (coeff p k)) x) : eval₂ f x (list.prod ps) = list.prod (list.map (eval₂ f x) ps) := sorry

/-- `eval₂` as a `ring_hom` for noncommutative rings -/
def eval₂_ring_hom' {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) (hf : ∀ (a : R), commute (coe_fn f a) x) : polynomial R →+* S :=
  ring_hom.mk (eval₂ f x) (eval₂_one f x) sorry (eval₂_zero f x) sorry

/-!
We next prove that eval₂ is multiplicative
as long as target ring is commutative
(even if the source ring is not).
-/

@[simp] theorem eval₂_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) : eval₂ f x (p * q) = eval₂ f x p * eval₂ f x q :=
  eval₂_mul_noncomm f x fun (k : ℕ) => commute.all (coe_fn f (coeff q k)) x

theorem eval₂_mul_eq_zero_of_left {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) (q : polynomial R) (hp : eval₂ f x p = 0) : eval₂ f x (p * q) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * q) = 0)) (eval₂_mul f x))) (mul_eq_zero_of_left hp (eval₂ f x q))

theorem eval₂_mul_eq_zero_of_right {R : Type u} {S : Type v} [semiring R] {q : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) (p : polynomial R) (hq : eval₂ f x q = 0) : eval₂ f x (p * q) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * q) = 0)) (eval₂_mul f x))) (mul_eq_zero_of_right (eval₂ f x p) hq)

protected instance eval₂.is_semiring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S) (x : S) : is_semiring_hom (eval₂ f x) :=
  is_semiring_hom.mk (eval₂_zero f x) (eval₂_one f x) (fun (_x _x_1 : polynomial R) => eval₂_add f x)
    fun (_x _x_1 : polynomial R) => eval₂_mul f x

/-- `eval₂` as a `ring_hom` -/
def eval₂_ring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S) (x : S) : polynomial R →+* S :=
  ring_hom.of (eval₂ f x)

@[simp] theorem coe_eval₂_ring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S) (x : S) : ⇑(eval₂_ring_hom f x) = eval₂ f x :=
  rfl

theorem eval₂_pow {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) (n : ℕ) : eval₂ f x (p ^ n) = eval₂ f x p ^ n :=
  ring_hom.map_pow (eval₂_ring_hom f x) p n

theorem eval₂_eq_sum_range {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) : eval₂ f x p = finset.sum (finset.range (nat_degree p + 1)) fun (i : ℕ) => coe_fn f (coeff p i) * x ^ i := sorry

theorem eval₂_eq_sum_range' {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S) {p : polynomial R} {n : ℕ} (hn : nat_degree p < n) (x : S) : eval₂ f x p = finset.sum (finset.range n) fun (i : ℕ) => coe_fn f (coeff p i) * x ^ i := sorry

/-- `eval x p` is the evaluation of the polynomial `p` at `x` -/
def eval {R : Type u} [semiring R] : R → polynomial R → R :=
  eval₂ (ring_hom.id R)

theorem eval_eq_sum {R : Type u} [semiring R] {p : polynomial R} {x : R} : eval x p = finsupp.sum p fun (e : ℕ) (a : R) => a * x ^ e :=
  rfl

@[simp] theorem eval_C {R : Type u} {a : R} [semiring R] {x : R} : eval x (coe_fn C a) = a :=
  eval₂_C (ring_hom.id R) x

@[simp] theorem eval_nat_cast {R : Type u} [semiring R] {x : R} {n : ℕ} : eval x ↑n = ↑n := sorry

@[simp] theorem eval_X {R : Type u} [semiring R] {x : R} : eval x X = x :=
  eval₂_X (ring_hom.id R) x

@[simp] theorem eval_monomial {R : Type u} [semiring R] {x : R} {n : ℕ} {a : R} : eval x (coe_fn (monomial n) a) = a * x ^ n :=
  eval₂_monomial (ring_hom.id R) x

@[simp] theorem eval_zero {R : Type u} [semiring R] {x : R} : eval x 0 = 0 :=
  eval₂_zero (ring_hom.id R) x

@[simp] theorem eval_add {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {x : R} : eval x (p + q) = eval x p + eval x q :=
  eval₂_add (ring_hom.id R) x

@[simp] theorem eval_one {R : Type u} [semiring R] {x : R} : eval x 1 = 1 :=
  eval₂_one (ring_hom.id R) x

@[simp] theorem eval_bit0 {R : Type u} [semiring R] {p : polynomial R} {x : R} : eval x (bit0 p) = bit0 (eval x p) :=
  eval₂_bit0 (ring_hom.id R) x

@[simp] theorem eval_bit1 {R : Type u} [semiring R] {p : polynomial R} {x : R} : eval x (bit1 p) = bit1 (eval x p) :=
  eval₂_bit1 (ring_hom.id R) x

@[simp] theorem eval_smul {R : Type u} [semiring R] (p : polynomial R) (x : R) {s : R} : eval x (s • p) = s • eval x p :=
  eval₂_smul (ring_hom.id R) p x

theorem eval_sum {R : Type u} [semiring R] (p : polynomial R) (f : ℕ → R → polynomial R) (x : R) : eval x (finsupp.sum p f) = finsupp.sum p fun (n : ℕ) (a : R) => eval x (f n a) :=
  eval₂_sum (ring_hom.id R) p f x

theorem eval_finset_sum {R : Type u} {ι : Type y} [semiring R] (s : finset ι) (g : ι → polynomial R) (x : R) : eval x (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => eval x (g i) :=
  eval₂_finset_sum (ring_hom.id R) s (fun (i : ι) => g i) x

/-- `is_root p x` implies `x` is a root of `p`. The evaluation of `p` at `x` is zero -/
def is_root {R : Type u} [semiring R] (p : polynomial R) (a : R) :=
  eval a p = 0

protected instance is_root.decidable {R : Type u} {a : R} [semiring R] {p : polynomial R} [DecidableEq R] : Decidable (is_root p a) :=
  eq.mpr sorry (_inst_2 (eval a p) 0)

@[simp] theorem is_root.def {R : Type u} {a : R} [semiring R] {p : polynomial R} : is_root p a ↔ eval a p = 0 :=
  iff.rfl

theorem coeff_zero_eq_eval_zero {R : Type u} [semiring R] (p : polynomial R) : coeff p 0 = eval 0 p := sorry

theorem zero_is_root_of_coeff_zero_eq_zero {R : Type u} [semiring R] {p : polynomial R} (hp : coeff p 0 = 0) : is_root p 0 :=
  eq.mp (Eq._oldrec (Eq.refl (coeff p 0 = 0)) (coeff_zero_eq_eval_zero p)) hp

/-- The composition of polynomials as a polynomial. -/
def comp {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) : polynomial R :=
  eval₂ C q p

theorem comp_eq_sum_left {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} : comp p q = finsupp.sum p fun (e : ℕ) (a : R) => coe_fn C a * q ^ e :=
  rfl

@[simp] theorem comp_X {R : Type u} [semiring R] {p : polynomial R} : comp p X = p := sorry

@[simp] theorem X_comp {R : Type u} [semiring R] {p : polynomial R} : comp X p = p :=
  eval₂_X C p

@[simp] theorem comp_C {R : Type u} {a : R} [semiring R] {p : polynomial R} : comp p (coe_fn C a) = coe_fn C (eval a p) := sorry

@[simp] theorem C_comp {R : Type u} {a : R} [semiring R] {p : polynomial R} : comp (coe_fn C a) p = coe_fn C a :=
  eval₂_C C p

@[simp] theorem comp_zero {R : Type u} [semiring R] {p : polynomial R} : comp p 0 = coe_fn C (eval 0 p) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp p 0 = coe_fn C (eval 0 p))) (Eq.symm C_0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp p (coe_fn C 0) = coe_fn C (eval 0 p))) comp_C))
      (Eq.refl (coe_fn C (eval 0 p))))

@[simp] theorem zero_comp {R : Type u} [semiring R] {p : polynomial R} : comp 0 p = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp 0 p = 0)) (Eq.symm C_0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp (coe_fn C 0) p = coe_fn C 0)) C_comp)) (Eq.refl (coe_fn C 0)))

@[simp] theorem comp_one {R : Type u} [semiring R] {p : polynomial R} : comp p 1 = coe_fn C (eval 1 p) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp p 1 = coe_fn C (eval 1 p))) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp p (coe_fn C 1) = coe_fn C (eval 1 p))) comp_C))
      (Eq.refl (coe_fn C (eval 1 p))))

@[simp] theorem one_comp {R : Type u} [semiring R] {p : polynomial R} : comp 1 p = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp 1 p = 1)) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp (coe_fn C 1) p = coe_fn C 1)) C_comp)) (Eq.refl (coe_fn C 1)))

@[simp] theorem add_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {r : polynomial R} : comp (p + q) r = comp p r + comp q r :=
  eval₂_add C r

@[simp] theorem mul_comp {R : Type u_1} [comm_semiring R] (p : polynomial R) (q : polynomial R) (r : polynomial R) : comp (p * q) r = comp p r * comp q r :=
  eval₂_mul C r

@[simp] theorem bit0_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} : comp (bit0 p) q = bit0 (comp p q) := sorry

@[simp] theorem bit1_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} : comp (bit1 p) q = bit1 (comp p q) := sorry

theorem comp_assoc {R : Type u_1} [comm_semiring R] (φ : polynomial R) (ψ : polynomial R) (χ : polynomial R) : comp (comp φ ψ) χ = comp φ (comp ψ χ) := sorry

/-- `map f p` maps a polynomial `p` across a ring hom `f` -/
def map {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : polynomial R → polynomial S :=
  eval₂ (ring_hom.comp C f) X

protected instance is_semiring_hom_C_f {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : is_semiring_hom (⇑C ∘ ⇑f) :=
  is_semiring_hom.comp ⇑f ⇑C

@[simp] theorem map_C {R : Type u} {S : Type v} {a : R} [semiring R] [semiring S] (f : R →+* S) : map f (coe_fn C a) = coe_fn C (coe_fn f a) :=
  eval₂_C (ring_hom.comp C f) X

@[simp] theorem map_X {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : map f X = X :=
  eval₂_X (ring_hom.comp C f) X

@[simp] theorem map_monomial {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) {n : ℕ} {a : R} : map f (coe_fn (monomial n) a) = coe_fn (monomial n) (coe_fn f a) := sorry

@[simp] theorem map_zero {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : map f 0 = 0 :=
  eval₂_zero (ring_hom.comp C f) X

@[simp] theorem map_add {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R} [semiring S] (f : R →+* S) : map f (p + q) = map f p + map f q :=
  eval₂_add (ring_hom.comp C f) X

@[simp] theorem map_one {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : map f 1 = 1 :=
  eval₂_one (ring_hom.comp C f) X

@[simp] theorem map_nat_cast {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (n : ℕ) : map f ↑n = ↑n := sorry

@[simp] theorem coeff_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (n : ℕ) : coeff (map f p) n = coe_fn f (coeff p n) := sorry

theorem map_map {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] (f : R →+* S) [semiring T] (g : S →+* T) (p : polynomial R) : map g (map f p) = map (ring_hom.comp g f) p := sorry

@[simp] theorem map_id {R : Type u} [semiring R] {p : polynomial R} : map (ring_hom.id R) p = p := sorry

theorem eval₂_eq_eval_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) {x : S} : eval₂ f x p = eval x (map f p) := sorry

theorem map_injective {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (hf : function.injective ⇑f) : function.injective (map f) := sorry

theorem map_surjective {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (hf : function.surjective ⇑f) : function.surjective (map f) := sorry

theorem map_monic_eq_zero_iff {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] {f : R →+* S} (hp : monic p) : map f p = 0 ↔ ∀ (x : R), coe_fn f x = 0 := sorry

theorem map_monic_ne_zero {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] {f : R →+* S} (hp : monic p) [nontrivial S] : map f p ≠ 0 :=
  fun (h : map f p = 0) => ring_hom.map_one_ne_zero f (iff.mp (map_monic_eq_zero_iff hp) h 1)

-- If the rings were commutative, we could prove this just using `eval₂_mul`.

-- TODO this proof is just a hack job on the proof of `eval₂_mul`,

-- using that `X` is central. It should probably be golfed!

@[simp] theorem map_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R} [semiring S] (f : R →+* S) : map f (p * q) = map f p * map f q := sorry

protected instance map.is_semiring_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : is_semiring_hom (map f) :=
  is_semiring_hom.mk (eval₂_zero (ring_hom.comp C f) X) (eval₂_one (ring_hom.comp C f) X)
    (fun (_x _x_1 : polynomial R) => eval₂_add (ring_hom.comp C f) X) fun (_x _x_1 : polynomial R) => map_mul f

/-- `polynomial.map` as a `ring_hom` -/
def map_ring_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : polynomial R →+* polynomial S :=
  ring_hom.mk (map f) sorry sorry sorry sorry

@[simp] theorem coe_map_ring_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : ⇑(map_ring_hom f) = map f :=
  rfl

theorem map_list_prod {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (L : List (polynomial R)) : map f (list.prod L) = list.prod (list.map (map f) L) :=
  Eq.symm (list.prod_hom L (monoid_hom.of (map f)))

@[simp] theorem map_pow {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (n : ℕ) : map f (p ^ n) = map f p ^ n :=
  is_monoid_hom.map_pow (map f) p n

theorem mem_map_range {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) {p : polynomial S} : p ∈ set.range (map f) ↔ ∀ (n : ℕ), coeff p n ∈ set.range ⇑f := sorry

theorem eval₂_map {R : Type u} {S : Type v} {T : Type w} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) [semiring T] (g : S →+* T) (x : T) : eval₂ g x (map f p) = eval₂ (ring_hom.comp g f) x p := sorry

theorem eval_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (f : R →+* S) (x : S) : eval x (map f p) = eval₂ f x p :=
  eval₂_map f (ring_hom.id S) x

theorem map_sum {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) {ι : Type u_1} (g : ι → polynomial R) (s : finset ι) : map f (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => map f (g i) :=
  Eq.symm (finset.sum_hom s (map f))

/-!
After having set up the basic theory of `eval₂`, `eval`, `comp`, and `map`,
we make `eval₂` irreducible.

Perhaps we can make the others irreducible too?
-/

-- TODO: Here we need commutativity in both `S` and `T`?

theorem hom_eval₂ {R : Type u} {S : Type v} {T : Type w} [semiring R] (p : polynomial R) [comm_semiring S] [comm_semiring T] (f : R →+* S) (g : S →+* T) (x : S) : coe_fn g (eval₂ f x p) = eval₂ (ring_hom.comp g f) (coe_fn g x) p := sorry

@[simp] theorem eval_mul {R : Type u} [comm_semiring R] {p : polynomial R} {q : polynomial R} {x : R} : eval x (p * q) = eval x p * eval x q :=
  eval₂_mul (ring_hom.id R) x

protected instance eval.is_semiring_hom {R : Type u} [comm_semiring R] {x : R} : is_semiring_hom (eval x) :=
  eval₂.is_semiring_hom (ring_hom.id R) x

@[simp] theorem eval_pow {R : Type u} [comm_semiring R] {p : polynomial R} {x : R} (n : ℕ) : eval x (p ^ n) = eval x p ^ n :=
  eval₂_pow (ring_hom.id R) x n

theorem eval₂_hom {R : Type u} {S : Type v} [comm_semiring R] {p : polynomial R} [comm_semiring S] (f : R →+* S) (x : R) : eval₂ f (coe_fn f x) p = coe_fn f (eval x p) :=
  ring_hom.comp_id f ▸ Eq.symm (hom_eval₂ p (ring_hom.id R) f x)

theorem root_mul_left_of_is_root {R : Type u} {a : R} [comm_semiring R] (p : polynomial R) {q : polynomial R} : is_root q a → is_root (p * q) a := sorry

theorem root_mul_right_of_is_root {R : Type u} {a : R} [comm_semiring R] {p : polynomial R} (q : polynomial R) : is_root p a → is_root (p * q) a := sorry

/--
Polynomial evaluation commutes with finset.prod
-/
theorem eval_prod {R : Type u} [comm_semiring R] {ι : Type u_1} (s : finset ι) (p : ι → polynomial R) (x : R) : eval x (finset.prod s fun (j : ι) => p j) = finset.prod s fun (j : ι) => eval x (p j) := sorry

theorem map_multiset_prod {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S) (m : multiset (polynomial R)) : map f (multiset.prod m) = multiset.prod (multiset.map (map f) m) :=
  Eq.symm (multiset.prod_hom m (monoid_hom.of (map f)))

theorem map_prod {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S) {ι : Type u_1} (g : ι → polynomial R) (s : finset ι) : map f (finset.prod s fun (i : ι) => g i) = finset.prod s fun (i : ι) => map f (g i) :=
  Eq.symm (finset.prod_hom s (map f))

theorem support_map_subset {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S) (p : polynomial R) : finsupp.support (map f p) ⊆ finsupp.support p := sorry

theorem map_comp {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S) (p : polynomial R) (q : polynomial R) : map f (comp p q) = comp (map f p) (map f q) := sorry

-- @[simp]

-- lemma C_eq_int_cast (n : ℤ) : C ↑n = (n : polynomial R) :=

-- (C : R →+* _).map_int_cast n

theorem C_neg {R : Type u} {a : R} [ring R] : coe_fn C (-a) = -coe_fn C a :=
  ring_hom.map_neg C a

theorem C_sub {R : Type u} {a : R} {b : R} [ring R] : coe_fn C (a - b) = coe_fn C a - coe_fn C b :=
  ring_hom.map_sub C a b

protected instance map.is_ring_hom {R : Type u} [ring R] {S : Type u_1} [ring S] (f : R →+* S) : is_ring_hom (map f) :=
  is_ring_hom.of_semiring (map f)

@[simp] theorem map_sub {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} {S : Type u_1} [ring S] (f : R →+* S) : map f (p - q) = map f p - map f q :=
  is_ring_hom.map_sub (map f)

@[simp] theorem map_neg {R : Type u} [ring R] {p : polynomial R} {S : Type u_1} [ring S] (f : R →+* S) : map f (-p) = -map f p :=
  is_ring_hom.map_neg (map f)

@[simp] theorem map_int_cast {R : Type u} [ring R] {S : Type u_1} [ring S] (f : R →+* S) (n : ℤ) : map f ↑n = ↑n :=
  ring_hom.map_int_cast (ring_hom.of (map f)) n

@[simp] theorem eval_int_cast {R : Type u} [ring R] {n : ℤ} {x : R} : eval x ↑n = ↑n := sorry

@[simp] theorem eval₂_neg {R : Type u} [ring R] {p : polynomial R} {S : Type u_1} [ring S] (f : R →+* S) {x : S} : eval₂ f x (-p) = -eval₂ f x p := sorry

@[simp] theorem eval₂_sub {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} {S : Type u_1} [ring S] (f : R →+* S) {x : S} : eval₂ f x (p - q) = eval₂ f x p - eval₂ f x q := sorry

@[simp] theorem eval_neg {R : Type u} [ring R] (p : polynomial R) (x : R) : eval x (-p) = -eval x p :=
  eval₂_neg (ring_hom.id R)

@[simp] theorem eval_sub {R : Type u} [ring R] (p : polynomial R) (q : polynomial R) (x : R) : eval x (p - q) = eval x p - eval x q :=
  eval₂_sub (ring_hom.id R)

theorem root_X_sub_C {R : Type u} {a : R} {b : R} [ring R] : is_root (X - coe_fn C a) b ↔ a = b := sorry

@[simp] theorem neg_comp {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} : comp (-p) q = -comp p q :=
  eval₂_neg C

@[simp] theorem sub_comp {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} {r : polynomial R} : comp (p - q) r = comp p r - comp q r :=
  eval₂_sub C

protected instance eval₂.is_ring_hom {R : Type u} [comm_ring R] {S : Type u_1} [comm_ring S] (f : R →+* S) {x : S} : is_ring_hom (eval₂ f x) :=
  is_ring_hom.of_semiring (eval₂ f x)

protected instance eval.is_ring_hom {R : Type u} [comm_ring R] {x : R} : is_ring_hom (eval x) :=
  eval₂.is_ring_hom (ring_hom.id R)


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import logic.nontrivial

/-!
# The `nontriviality` tactic.

-/

namespace tactic

/--
Tries to generate a `nontrivial α` instance by performing case analysis on
`subsingleton_or_nontrivial α`,
attempting to discharge the subsingleton branch using lemmas with `@[nontriviality]` attribute,
including `subsingleton.le` and `eq_iff_true_of_subsingleton`.
-/
meta def nontriviality_by_elim (α : expr) (lems : interactive.parse simp_arg_list) : tactic unit :=
do
  alternative ← to_expr ``(subsingleton_or_nontrivial %%α),
  n ← get_unused_name "_inst",
  tactic.cases alternative [n, n],
  (solve1 $ do
    reset_instance_cache,
    apply_instance <|>
      interactive.simp none none ff lems [`nontriviality] (interactive.loc.ns [none])) <|>
      fail format!"Could not prove goal assuming `subsingleton {α}`",
  reset_instance_cache

/--
Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
and local hypotheses.
-/
meta def nontriviality_by_assumption (α : expr) : tactic unit :=
do
  n ← get_unused_name "_inst",
  to_expr ``(nontrivial %%α) >>= assert n,
  apply_instance <|> `[solve_by_elim [nontrivial_of_ne, nontrivial_of_lt]],
  reset_instance_cache

end tactic

namespace tactic.interactive

open tactic

setup_tactic_parser

/--
Attempts to generate a `nontrivial α` hypothesis.

The tactic first looks for an instance using `apply_instance`.

If the goal is an (in)equality, the type `α` is inferred from the goal.
Otherwise, the type needs to be specified in the tactic invocation, as `nontriviality α`.

The `nontriviality` tactic will first look for strict inequalities amongst the hypotheses,
and use these to derive the `nontrivial` instance directly.

Otherwise, it will perform a case split on `subsingleton α ∨ nontrivial α`, and attempt to discharge
the `subsingleton` goal using `simp [lemmas] with nontriviality`, where `[lemmas]` is a list of
additional `simp` lemmas that can be passed to `nontriviality` using the syntax
`nontriviality α using [lemmas]`.

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  assumption,
end
```

```
example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  apply mul_comm,
end
```

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : (2 : ℕ) ∣ 4 :=
begin
  nontriviality R, -- there is now a `nontrivial R` hypothesis available.
  dec_trivial
end
```

```
def myeq {α : Type} (a b : α) : Prop := a = b

example {α : Type} (a b : α) (h : a = b) : myeq a b :=
begin
  success_if_fail { nontriviality α }, -- Fails
  nontriviality α using [myeq], -- There is now a `nontrivial α` hypothesis available
  assumption
end
```
-/
meta def nontriviality (t : parse texpr?)
  (lems : parse (tk "using" *> simp_arg_list <|> pure [])) :
  tactic unit :=
do
  α ← match t with
  | some α := to_expr α
  | none :=
    (do t ← mk_mvar, e ← to_expr ``(@eq %%t _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@has_le.le %%t _ _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@ne %%t _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@has_lt.lt %%t _ _ _), target >>= unify e, return t) <|>
    fail "The goal is not an (in)equality, so you'll need to specify the desired `nontrivial α`
      instance by invoking `nontriviality α`."
  end,
  nontriviality_by_assumption α <|> nontriviality_by_elim α lems

add_tactic_doc
{ name                     := "nontriviality",
  category                 := doc_category.tactic,
  decl_names               := [`tactic.interactive.nontriviality],
  tags                     := ["logic", "type class"] }

end tactic.interactive