/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau

Dependent functions with finite support (see `data/finsupp.lean`).
-/

import data.finset data.set.finite algebra.big_operators algebra.module algebra.pi_instances

universes u u₁ u₂ v v₁ v₂ v₃ w x y l

variables (ι : Type u) (β : ι → Type v)

def decidable_zero_symm {γ : Type w} [has_zero γ] [decidable_pred (eq (0 : γ))] : decidable_pred (λ x, x = (0:γ)) :=
λ x, decidable_of_iff (0 = x) eq_comm
local attribute [instance] decidable_zero_symm

namespace dfinsupp

variable [Π i, has_zero (β i)]

structure pre : Type (max u v) :=
(to_fun : Π i, β i)
(pre_support : multiset ι)
(zero : ∀ i, i ∈ pre_support ∨ to_fun i = 0)

instance : setoid (pre ι β) :=
{ r := λ x y, ∀ i, x.to_fun i = y.to_fun i,
  iseqv := ⟨λ f i, rfl, λ f g H i, (H i).symm,
    λ f g h H1 H2 i, (H1 i).trans (H2 i)⟩ }

end dfinsupp

variable {ι}
@[reducible] def dfinsupp [Π i, has_zero (β i)] : Type* :=
quotient (dfinsupp.setoid ι β)
variable {β}

notation `Π₀` binders `, ` r:(scoped f, dfinsupp f) := r
infix ` →ₚ `:25 := dfinsupp

namespace dfinsupp

section basic
variables [Π i, has_zero (β i)]
variables {β₁ : ι → Type v₁} {β₂ : ι → Type v₂}
variables [Π i, has_zero (β₁ i)] [Π i, has_zero (β₂ i)]

instance : has_coe_to_fun (Π₀ i, β i) :=
⟨λ _, Π i, β i, λ f, quotient.lift_on f pre.to_fun $ λ _ _, funext⟩

instance : has_zero (Π₀ i, β i) := ⟨⟦⟨λ i, 0, ∅, λ i, or.inr rfl⟩⟧⟩
instance : inhabited (Π₀ i, β i) := ⟨0⟩

@[simp] lemma zero_apply {i : ι} : (0 : Π₀ i, β i) i = 0 := rfl

@[extensionality]
lemma ext {f g : Π₀ i, β i} (H : ∀ i, f i = g i) : f = g :=
quotient.induction_on₂ f g (λ _ _ H, quotient.sound H) H

/-- The composition of `f : β₁ → β₂` and `g : Π₀ i, β₁ i` is
  `map_range f hf g : Π₀ i, β₂ i`, well defined when `f 0 = 0`. -/
def map_range (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0) (g : Π₀ i, β₁ i) : Π₀ i, β₂ i :=
quotient.lift_on g (λ x, ⟦(⟨λ i, f i (x.1 i), x.2,
  λ i, or.cases_on (x.3 i) or.inl $ λ H, or.inr $ by rw [H, hf]⟩ : pre ι β₂)⟧) $ λ x y H,
quotient.sound $ λ i, by simp only [H i]

@[simp] lemma map_range_apply
  {f : Π i, β₁ i → β₂ i} {hf : ∀ i, f i 0 = 0} {g : Π₀ i, β₁ i} {i : ι} :
  map_range f hf g i = f i (g i) :=
quotient.induction_on g $ λ x, rfl

def zip_with (f : Π i, β₁ i → β₂ i → β i) (hf : ∀ i, f i 0 0 = 0) (g₁ : Π₀ i, β₁ i) (g₂ : Π₀ i, β₂ i) : (Π₀ i, β i) :=
begin
  refine quotient.lift_on₂ g₁ g₂ (λ x y, ⟦(⟨λ i, f i (x.1 i) (y.1 i), x.2 + y.2,
    λ i, _⟩ : pre ι β)⟧) _,
  { cases x.3 i with h1 h1,
    { left, rw multiset.mem_add, left, exact h1 },
    cases y.3 i with h2 h2,
    { left, rw multiset.mem_add, right, exact h2 },
    right, rw [h1, h2, hf] },
  exact λ x₁ x₂ y₁ y₂ H1 H2, quotient.sound $ λ i, by simp only [H1 i, H2 i]
end

@[simp] lemma zip_with_apply
  {f : Π i, β₁ i → β₂ i → β i} {hf : ∀ i, f i 0 0 = 0} {g₁ : Π₀ i, β₁ i} {g₂ : Π₀ i, β₂ i} {i : ι} :
  zip_with f hf g₁ g₂ i = f i (g₁ i) (g₂ i) :=
quotient.induction_on₂ g₁ g₂ $ λ _ _, rfl

end basic

section algebra

instance [Π i, add_monoid (β i)] : has_add (Π₀ i, β i) :=
⟨zip_with (λ _, (+)) (λ _, add_zero 0)⟩

@[simp] lemma add_apply [Π i, add_monoid (β i)] {g₁ g₂ : Π₀ i, β i} {i : ι} :
  (g₁ + g₂) i = g₁ i + g₂ i :=
zip_with_apply

instance [Π i, add_monoid (β i)] : add_monoid (Π₀ i, β i) :=
{ add_monoid .
  zero      := 0,
  add       := (+),
  add_assoc := λ f g h, ext $ λ i, by simp only [add_apply, add_assoc],
  zero_add  := λ f, ext $ λ i, by simp only [add_apply, zero_apply, zero_add],
  add_zero  := λ f, ext $ λ i, by simp only [add_apply, zero_apply, add_zero] }

instance [Π i, add_monoid (β i)] {i : ι} : is_add_monoid_hom (λ g : Π₀ i : ι, β i, g i) :=
by refine_struct {..}; simp

instance [Π i, add_group (β i)] : has_neg (Π₀ i, β i) :=
⟨λ f, f.map_range (λ _, has_neg.neg) (λ _, neg_zero)⟩

instance [Π i, add_comm_monoid (β i)] : add_comm_monoid (Π₀ i, β i) :=
{ add_comm := λ f g, ext $ λ i, by simp only [add_apply, add_comm],
  .. dfinsupp.add_monoid }

@[simp] lemma neg_apply [Π i, add_group (β i)] {g : Π₀ i, β i} {i : ι} : (- g) i = - g i :=
map_range_apply

instance [Π i, add_group (β i)] : add_group (Π₀ i, β i) :=
{ add_left_neg := λ f, ext $ λ i, by simp only [add_apply, neg_apply, zero_apply, add_left_neg],
  .. dfinsupp.add_monoid,
  .. (infer_instance : has_neg (Π₀ i, β i)) }

@[simp] lemma sub_apply [Π i, add_group (β i)] {g₁ g₂ : Π₀ i, β i} {i : ι} : (g₁ - g₂) i = g₁ i - g₂ i :=
by rw [sub_eq_add_neg]; simp

instance [Π i, add_comm_group (β i)] : add_comm_group (Π₀ i, β i) :=
{ add_comm := λ f g, ext $ λ i, by simp only [add_apply, add_comm],
  ..dfinsupp.add_group }

def to_has_scalar {γ : Type w} [ring γ] [Π i, add_comm_group (β i)] [Π i, module γ (β i)] : has_scalar γ (Π₀ i, β i) :=
⟨λc v, v.map_range (λ _, (•) c) (λ _, smul_zero _)⟩
local attribute [instance] to_has_scalar

@[simp] lemma smul_apply {γ : Type w} [ring γ] [Π i, add_comm_group (β i)] [Π i, module γ (β i)] {i : ι} {b : γ} {v : Π₀ i, β i} :
  (b • v) i = b • (v i) :=
map_range_apply

def to_module {γ : Type w} [ring γ] [Π i, add_comm_group (β i)] [Π i, module γ (β i)] : module γ (Π₀ i, β i) :=
module.of_core {
  smul_add := λ c x y, ext $ λ i, by simp only [add_apply, smul_apply, smul_add],
  add_smul := λ c x y, ext $ λ i, by simp only [add_apply, smul_apply, add_smul],
  one_smul := λ x, ext $ λ i, by simp only [smul_apply, one_smul],
  mul_smul := λ r s x, ext $ λ i, by simp only [smul_apply, smul_smul],
  .. (infer_instance : has_scalar γ (Π₀ i, β i)) }

end algebra

section filter_and_subtype_domain

/-- `filter p f` is the function which is `f i` if `p i` is true and 0 otherwise. -/
def filter [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] (f : Π₀ i, β i) : Π₀ i, β i :=
quotient.lift_on f (λ x, ⟦(⟨λ i, if p i then x.1 i else 0, x.2,
  λ i, or.cases_on (x.3 i) or.inl $ λ H, or.inr $ by rw [H, if_t_t]⟩ : pre ι β)⟧) $ λ x y H,
quotient.sound $ λ i, by simp only [H i]

@[simp] lemma filter_apply [Π i, has_zero (β i)]
  {p : ι → Prop} [decidable_pred p] {i : ι} {f : Π₀ i, β i} :
  f.filter p i = if p i then f i else 0 :=
quotient.induction_on f $ λ x, rfl

@[simp] lemma filter_apply_pos [Π i, has_zero (β i)]
  {p : ι → Prop} [decidable_pred p] {f : Π₀ i, β i} {i : ι} (h : p i) :
  f.filter p i = f i :=
by simp only [filter_apply, if_pos h]

@[simp] lemma filter_apply_neg [Π i, has_zero (β i)]
  {p : ι → Prop} [decidable_pred p] {f : Π₀ i, β i} {i : ι} (h : ¬ p i) :
  f.filter p i = 0 :=
by simp only [filter_apply, if_neg h]

lemma filter_pos_add_filter_neg [Π i, add_monoid (β i)] {f : Π₀ i, β i}
  {p : ι → Prop} [decidable_pred p] :
  f.filter p + f.filter (λi, ¬ p i) = f :=
ext $ λ i, by simp only [add_apply, filter_apply]; split_ifs; simp only [add_zero, zero_add]

/-- `subtype_domain p f` is the restriction of the finitely supported function
  `f` to the subtype `p`. -/
def subtype_domain [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p]
  (f : Π₀ i, β i) : Π₀ i : subtype p, β i.1 :=
begin
  fapply quotient.lift_on f,
  { intro x, refine ⟦⟨λ i, x.1 i.1, (x.2.filter p).attach.map $ λ j, ⟨j.1, (multiset.mem_filter.1 j.2).2⟩, _⟩⟧,
    refine λ i, or.cases_on (x.3 i.1) (λ H, _) or.inr,
    left, rw multiset.mem_map, refine ⟨⟨i.1, multiset.mem_filter.2 ⟨H, i.2⟩⟩, _, subtype.eta _ _⟩,
    apply multiset.mem_attach },
  intros x y H,
  exact quotient.sound (λ i, H i.1)
end

@[simp] lemma subtype_domain_zero [Π i, has_zero (β i)] {p : ι → Prop} [decidable_pred p] :
  subtype_domain p (0 : Π₀ i, β i) = 0 :=
rfl

@[simp] lemma subtype_domain_apply [Π i, has_zero (β i)] {p : ι → Prop} [decidable_pred p]
  {i : subtype p} {v : Π₀ i, β i} :
  (subtype_domain p v) i = v (i.val) :=
quotient.induction_on v $ λ x, rfl

@[simp] lemma subtype_domain_add [Π i, add_monoid (β i)] {p : ι → Prop} [decidable_pred p] {v v' : Π₀ i, β i} :
  (v + v').subtype_domain p = v.subtype_domain p + v'.subtype_domain p :=
ext $ λ i, by simp only [add_apply, subtype_domain_apply]

instance subtype_domain.is_add_monoid_hom [Π i, add_monoid (β i)] {p : ι → Prop} [decidable_pred p] :
  is_add_monoid_hom (subtype_domain p : (Π₀ i : ι, β i) → Π₀ i : subtype p, β i) :=
by refine_struct {..}; simp

@[simp] lemma subtype_domain_neg [Π i, add_group (β i)] {p : ι → Prop} [decidable_pred p] {v : Π₀ i, β i} :
  (- v).subtype_domain p = - v.subtype_domain p :=
ext $ λ i, by simp only [neg_apply, subtype_domain_apply]

@[simp] lemma subtype_domain_sub [Π i, add_group (β i)] {p : ι → Prop} [decidable_pred p] {v v' : Π₀ i, β i} :
  (v - v').subtype_domain p = v.subtype_domain p - v'.subtype_domain p :=
ext $ λ i, by simp only [sub_apply, subtype_domain_apply]

end filter_and_subtype_domain

variable [decidable_eq ι]

section basic
variable [Π i, has_zero (β i)]

lemma finite_supp (f : Π₀ i, β i) : set.finite {i | f i ≠ 0} :=
quotient.induction_on f $ λ x, set.finite_subset
  (finset.finite_to_set x.2.to_finset) $ λ i H,
multiset.mem_to_finset.2 $ (x.3 i).resolve_right H

def mk (s : finset ι) (x : Π i : (↑s : set ι), β i.1) : Π₀ i, β i :=
⟦⟨λ i, if H : i ∈ s then x ⟨i, H⟩ else 0, s.1,
λ i, if H : i ∈ s then or.inl H else or.inr $ dif_neg H⟩⟧

@[simp] lemma mk_apply {s : finset ι} {x : Π i : (↑s : set ι), β i.1} {i : ι} :
  (mk s x : Π i, β i) i = if H : i ∈ s then x ⟨i, H⟩ else 0 :=
rfl

theorem mk_inj (s : finset ι) : function.injective (@mk ι β _ _ s) :=
begin
  intros x y H,
  ext i,
  have h1 : (mk s x : Π i, β i) i = (mk s y : Π i, β i) i, {rw H},
  cases i with i hi,
  change i ∈ s at hi,
  dsimp only [mk_apply, subtype.coe_mk] at h1,
  simpa only [dif_pos hi] using h1
end

def single (i : ι) (b : β i) : Π₀ i, β i :=
mk (finset.singleton i) $ λ j, eq.rec_on (finset.mem_singleton.1 j.2).symm b

@[simp] lemma single_apply {i i' b} : (single i b : Π₀ i, β i) i' = (if h : i = i' then eq.rec_on h b else 0) :=
begin
  dsimp only [single],
  by_cases h : i = i',
  { have h1 : i' ∈ finset.singleton i, { simp only [h, finset.mem_singleton] },
    simp only [mk_apply, dif_pos h, dif_pos h1] },
  { have h1 : i' ∉ finset.singleton i, { simp only [ne.symm h, finset.mem_singleton, not_false_iff] },
    simp only [mk_apply, dif_neg h, dif_neg h1] }
end

@[simp] lemma single_zero {i} : (single i 0 : Π₀ i, β i) = 0 :=
quotient.sound $ λ j, if H : j ∈ finset.singleton i
then by dsimp only; rw [dif_pos H]; cases finset.mem_singleton.1 H; refl
else dif_neg H

@[simp] lemma single_eq_same {i b} : (single i b : Π₀ i, β i) i = b :=
by simp only [single_apply, dif_pos rfl]

@[simp] lemma single_eq_of_ne {i i' b} (h : i ≠ i') : (single i b : Π₀ i, β i) i' = 0 :=
by simp only [single_apply, dif_neg h]

def erase (i : ι) (f : Π₀ i, β i) : Π₀ i, β i :=
quotient.lift_on f (λ x, ⟦(⟨λ j, if j = i then 0 else x.1 j, x.2,
λ j, or.cases_on (x.3 j) or.inl $ λ H, or.inr $ by simp only [H, if_t_t]⟩ : pre ι β)⟧) $ λ x y H,
quotient.sound $ λ j, if h : j = i then by simp only [if_pos h]
else by simp only [if_neg h, H j]

@[simp] lemma erase_apply {i j : ι} {f : Π₀ i, β i} :
  (f.erase i) j = if j = i then 0 else f j :=
quotient.induction_on f $ λ x, rfl

@[simp] lemma erase_same {i : ι} {f : Π₀ i, β i} : (f.erase i) i = 0 :=
by simp

@[simp] lemma erase_ne {i i' : ι} {f : Π₀ i, β i} (h : i' ≠ i) : (f.erase i) i' = f i' :=
by simp [h]

end basic

section add_monoid

variable [Π i, add_monoid (β i)]

@[simp] lemma single_add {i : ι} {b₁ b₂ : β i} : single i (b₁ + b₂) = single i b₁ + single i b₂ :=
ext $ assume i',
begin
  by_cases h : i = i',
  { subst h, simp only [add_apply, single_eq_same] },
  { simp only [add_apply, single_eq_of_ne h, zero_add] }
end

lemma single_add_erase {i : ι} {f : Π₀ i, β i} : single i (f i) + f.erase i = f :=
ext $ λ i',
if h : i = i' then by subst h; simp only [add_apply, single_apply, erase_apply, dif_pos rfl, if_pos, add_zero]
else by simp only [add_apply, single_apply, erase_apply, dif_neg h, if_neg (ne.symm h), zero_add]

lemma erase_add_single {i : ι} {f : Π₀ i, β i} : f.erase i + single i (f i) = f :=
ext $ λ i',
if h : i = i' then by subst h; simp only [add_apply, single_apply, erase_apply, dif_pos rfl, if_pos, zero_add]
else by simp only [add_apply, single_apply, erase_apply, dif_neg h, if_neg (ne.symm h), add_zero]

protected theorem induction {p : (Π₀ i, β i) → Prop} (f : Π₀ i, β i)
  (h0 : p 0) (ha : ∀i b (f : Π₀ i, β i), f i = 0 → b ≠ 0 → p f → p (single i b + f)) :
  p f :=
begin
  refine quotient.induction_on f (λ x, _),
  cases x with f s H, revert f H,
  apply multiset.induction_on s,
  { intros f H, convert h0, ext i, exact (H i).resolve_left id },
  intros i s ih f H,
  by_cases H1 : i ∈ s,
  { have H2 : ∀ j, j ∈ s ∨ f j = 0,
    { intro j, cases H j with H2 H2,
      { cases multiset.mem_cons.1 H2 with H3 H3,
        { left, rw H3, exact H1 },
        { left, exact H3 } },
      right, exact H2 },
    have H3 : (⟦{to_fun := f, pre_support := i :: s, zero := H}⟧ : Π₀ i, β i)
      = ⟦{to_fun := f, pre_support := s, zero := H2}⟧,
    { exact quotient.sound (λ i, rfl) },
    rw H3, apply ih },
  have H2 : p (erase i ⟦{to_fun := f, pre_support := i :: s, zero := H}⟧),
  { dsimp only [erase, quotient.lift_on_beta],
    have H2 : ∀ j, j ∈ s ∨ ite (j = i) 0 (f j) = 0,
    { intro j, cases H j with H2 H2,
      { cases multiset.mem_cons.1 H2 with H3 H3,
        { right, exact if_pos H3 },
        { left, exact H3 } },
      right, split_ifs; [refl, exact H2] },
    have H3 : (⟦{to_fun := λ (j : ι), ite (j = i) 0 (f j), pre_support := i :: s, zero := _}⟧ : Π₀ i, β i)
      = ⟦{to_fun := λ (j : ι), ite (j = i) 0 (f j), pre_support := s, zero := H2}⟧ :=
      quotient.sound (λ i, rfl),
    rw H3, apply ih },
  have H3 : single i _ + _ = (⟦{to_fun := f, pre_support := i :: s, zero := H}⟧ : Π₀ i, β i) := single_add_erase,
  rw ← H3,
  change p (single i (f i) + _),
  cases classical.em (f i = 0) with h h,
  { rw [h, single_zero, zero_add], exact H2 },
  refine ha _ _ _ _ h H2,
  rw erase_same
end

lemma induction₂ {p : (Π₀ i, β i) → Prop} (f : Π₀ i, β i)
  (h0 : p 0) (ha : ∀i b (f : Π₀ i, β i), f i = 0 → b ≠ 0 → p f → p (f + single i b)) :
  p f :=
dfinsupp.induction f h0 $ λ i b f h1 h2 h3,
have h4 : f + single i b = single i b + f,
{ ext j, by_cases H : i = j,
  { subst H, simp [h1] },
  { simp [H] } },
eq.rec_on h4 $ ha i b f h1 h2 h3

end add_monoid

@[simp] lemma mk_add [Π i, add_monoid (β i)] {s : finset ι} {x y : Π i : (↑s : set ι), β i.1} :
  mk s (x + y) = mk s x + mk s y :=
ext $ λ i, by simp only [add_apply, mk_apply]; split_ifs; [refl, rw zero_add]

@[simp] lemma mk_zero [Π i, has_zero (β i)] {s : finset ι} :
  mk s (0 : Π i : (↑s : set ι), β i.1) = 0 :=
ext $ λ i, by simp only [mk_apply]; split_ifs; refl

@[simp] lemma mk_neg [Π i, add_group (β i)] {s : finset ι} {x : Π i : (↑s : set ι), β i.1} :
  mk s (-x) = -mk s x :=
ext $ λ i, by simp only [neg_apply, mk_apply]; split_ifs; [refl, rw neg_zero]

@[simp] lemma mk_sub [Π i, add_group (β i)] {s : finset ι} {x y : Π i : (↑s : set ι), β i.1} :
  mk s (x - y) = mk s x - mk s y :=
ext $ λ i, by simp only [sub_apply, mk_apply]; split_ifs; [refl, rw sub_zero]

instance [Π i, add_group (β i)] {s : finset ι} : is_add_group_hom (@mk ι β _ _ s) :=
⟨λ _ _, mk_add⟩

section
local attribute [instance] to_module
variables (γ : Type w) [ring γ] [Π i, add_comm_group (β i)] [Π i, module γ (β i)]
include γ
@[simp] lemma mk_smul {s : finset ι} {c : γ} (x : Π i : (↑s : set ι), β i.1) :
  mk s (c • x) = c • mk s x :=
ext $ λ i, by simp only [smul_apply, mk_apply]; split_ifs; [refl, rw smul_zero]

@[simp] lemma single_smul {i : ι} {c : γ} {x : β i} :
  single i (c • x) = c • single i x :=
ext $ λ i, by simp only [smul_apply, single_apply]; split_ifs; [cases h, rw smul_zero]; refl

variable β
def lmk (s : finset ι) : (Π i : (↑s : set ι), β i.1) →ₗ[γ] Π₀ i, β i :=
⟨mk s, λ _ _, mk_add, λ c x, by rw [mk_smul γ x]⟩

def lsingle (i) : β i →ₗ[γ] Π₀ i, β i :=
⟨single i, λ _ _, single_add, λ _ _, single_smul _⟩
variable {β}

@[simp] lemma lmk_apply {s : finset ι} {x} : lmk β γ s x = mk s x := rfl

@[simp] lemma lsingle_apply {i : ι} {x : β i} : lsingle β γ i x = single i x := rfl
end

section support_basic

variables [Π i, has_zero (β i)] [Π i, decidable_pred (eq (0 : β i))]

def support (f : Π₀ i, β i) : finset ι :=
quotient.lift_on f (λ x, x.2.to_finset.filter $ λ i, x.1 i ≠ 0) $
begin
  intros x y Hxy,
  ext i, split,
  { intro H,
    rcases finset.mem_filter.1 H with ⟨h1, h2⟩,
    rw Hxy i at h2,
    exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (y.3 i).resolve_right h2, h2⟩ },
  { intro H,
    rcases finset.mem_filter.1 H with ⟨h1, h2⟩,
    rw ← Hxy i at h2,
    exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (x.3 i).resolve_right h2, h2⟩ },
end

@[simp] theorem support_mk_subset {s : finset ι} {x : Π i : (↑s : set ι), β i.1} : (mk s x).support ⊆ s :=
λ i H, multiset.mem_to_finset.1 (finset.mem_filter.1 H).1

@[simp] theorem mem_support_to_fun (f : Π₀ i, β i) (i) : i ∈ f.support ↔ f i ≠ 0 :=
begin
  refine quotient.induction_on f (λ x, _),
  dsimp only [support, quotient.lift_on_beta],
  rw [finset.mem_filter, multiset.mem_to_finset],
  exact and_iff_right_of_imp (x.3 i).resolve_right
end

theorem eq_mk_support (f : Π₀ i, β i) : f = mk f.support (λ i, f i.1) :=
by ext i; by_cases h : f i = 0; try {simp at h}; simp [h]

@[simp] lemma support_zero : (0 : Π₀ i, β i).support = ∅ := rfl

@[simp] lemma mem_support_iff (f : Π₀ i, β i) : ∀i:ι, i ∈ f.support ↔ f i ≠ 0 :=
f.mem_support_to_fun

@[simp] lemma support_eq_empty {f : Π₀ i, β i} : f.support = ∅ ↔ f = 0 :=
⟨λ H, ext $ by simpa [finset.ext] using H, by simp {contextual:=tt}⟩

instance decidable_zero : decidable_pred (eq (0 : Π₀ i, β i)) :=
λ f, decidable_of_iff _ $ support_eq_empty.trans eq_comm

lemma support_subset_iff {s : set ι} {f : Π₀ i, β i} :
  ↑f.support ⊆ s ↔ (∀i∉s, f i = 0) :=
by simp [set.subset_def];
   exact forall_congr (assume i, @not_imp_comm _ _ (classical.dec _) (classical.dec _))

lemma support_single_ne_zero {i : ι} {b : β i} (hb : b ≠ 0) : (single i b).support = {i} :=
begin
  ext j, by_cases h : i = j,
  { subst h, simp [hb] },
  simp [ne.symm h, h]
end

lemma support_single_subset {i : ι} {b : β i} : (single i b).support ⊆ {i} :=
support_mk_subset

section map_range_and_zip_with

variables {β₁ : ι → Type v₁} {β₂ : ι → Type v₂}
variables [Π i, has_zero (β₁ i)] [Π i, has_zero (β₂ i)]
variables [Π i, decidable_pred (eq (0 : β₁ i))] [Π i, decidable_pred (eq (0 : β₂ i))]

lemma map_range_def {f : Π i, β₁ i → β₂ i} {hf : ∀ i, f i 0 = 0} {g : Π₀ i, β₁ i} :
  map_range f hf g = mk g.support (λ i, f i.1 (g i.1)) :=
begin
  ext i,
  by_cases h : g i = 0,
  { simp [h, hf] },
  { simp at h, simp [h, hf] }
end

lemma support_map_range {f : Π i, β₁ i → β₂ i} {hf : ∀ i, f i 0 = 0} {g : Π₀ i, β₁ i} :
  (map_range f hf g).support ⊆ g.support :=
by simp [map_range_def]

@[simp] lemma map_range_single {f : Π i, β₁ i → β₂ i} {hf : ∀ i, f i 0 = 0} {i : ι} {b : β₁ i} :
  map_range f hf (single i b) = single i (f i b) :=
dfinsupp.ext $ λ i', by by_cases i = i'; [{subst i', simp}, simp [h, hf]]

lemma zip_with_def {f : Π i, β₁ i → β₂ i → β i} {hf : ∀ i, f i 0 0 = 0} {g₁ : Π₀ i, β₁ i} {g₂ : Π₀ i, β₂ i} :
  zip_with f hf g₁ g₂ = mk (g₁.support ∪ g₂.support) (λ i, f i.1 (g₁ i.1) (g₂ i.1)) :=
begin
  ext i,
  by_cases h1 : g₁ i = 0; by_cases h2 : g₂ i = 0;
  try {simp at h1 h2}; simp [h1, h2, hf]
end

lemma support_zip_with {f : Π i, β₁ i → β₂ i → β i} {hf : ∀ i, f i 0 0 = 0} {g₁ : Π₀ i, β₁ i} {g₂ : Π₀ i, β₂ i} :
  (zip_with f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support :=
by simp [zip_with_def]

end map_range_and_zip_with

lemma erase_def (i : ι) (f : Π₀ i, β i) :
  f.erase i = mk (f.support.erase i) (λ j, f j.1) :=
begin
  ext j,
  by_cases h1 : j = i; by_cases h2 : f j = 0;
  try {simp at h2}; simp [h1, h2]
end

@[simp] lemma support_erase (i : ι) (f : Π₀ i, β i) :
  (f.erase i).support = f.support.erase i :=
begin
  ext j,
  by_cases h1 : j = i; by_cases h2 : f j = 0;
  try {simp at h2}; simp [h1, h2]
end

section filter_and_subtype_domain

variables {p : ι → Prop} [decidable_pred p]

lemma filter_def (f : Π₀ i, β i) :
  f.filter p = mk (f.support.filter p) (λ i, f i.1) :=
by ext i; by_cases h1 : p i; by_cases h2 : f i = 0;
try {simp at h2}; simp [h1, h2]

@[simp] lemma support_filter (f : Π₀ i, β i) :
  (f.filter p).support = f.support.filter p :=
by ext i; by_cases h : p i; simp [h]

lemma subtype_domain_def (f : Π₀ i, β i) :
  f.subtype_domain p = mk (f.support.subtype p) (λ i, f i.1) :=
by ext i; cases i with i hi;
by_cases h1 : p i; by_cases h2 : f i = 0;
try {simp at h2}; dsimp; simp [h1, h2]

@[simp] lemma support_subtype_domain {f : Π₀ i, β i} :
  (subtype_domain p f).support = f.support.subtype p :=
by ext i; cases i with i hi;
by_cases h1 : p i; by_cases h2 : f i = 0;
try {simp at h2}; dsimp; simp [h1, h2]

end filter_and_subtype_domain

end support_basic

lemma support_add [Π i, add_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))] {g₁ g₂ : Π₀ i, β i} :
  (g₁ + g₂).support ⊆ g₁.support ∪ g₂.support :=
support_zip_with

@[simp] lemma support_neg [Π i, add_group (β i)] [Π i, decidable_pred (eq (0 : β i))] {f : Π₀ i, β i} :
  support (-f) = support f :=
by ext i; simp

instance [decidable_eq ι] [Π i, has_zero (β i)] [Π i, decidable_eq (β i)] : decidable_eq (Π₀ i, β i) :=
assume f g, decidable_of_iff (f.support = g.support ∧ (∀i∈f.support, f i = g i))
  ⟨assume ⟨h₁, h₂⟩, ext $ assume i,
      if h : i ∈ f.support then h₂ i h else
        have hf : f i = 0, by rwa [f.mem_support_iff, not_not] at h,
        have hg : g i = 0, by rwa [h₁, g.mem_support_iff, not_not] at h,
        by rw [hf, hg],
    by intro h; subst h; simp⟩

section prod_and_sum

variables {γ : Type w}

-- [to_additive dfinsupp.sum] for dfinsupp.prod doesn't work, the equation lemmas are not generated
/-- `sum f g` is the sum of `g i (f i)` over the support of `f`. -/
def sum [Π i, has_zero (β i)] [Π i, decidable_pred (eq (0 : β i))] [add_comm_monoid γ]
  (f : Π₀ i, β i) (g : Π i, β i → γ) : γ :=
f.support.sum (λi, g i (f i))

/-- `prod f g` is the product of `g i (f i)` over the support of `f`. -/
@[to_additive dfinsupp.sum]
def prod [Π i, has_zero (β i)] [Π i, decidable_pred (eq (0 : β i))] [comm_monoid γ]
  (f : Π₀ i, β i) (g : Π i, β i → γ) : γ :=
f.support.prod (λi, g i (f i))
attribute [to_additive dfinsupp.sum.equations._eqn_1] dfinsupp.prod.equations._eqn_1

@[to_additive dfinsupp.sum_map_range_index]
lemma prod_map_range_index {β₁ : ι → Type v₁} {β₂ : ι → Type v₂}
  [Π i, has_zero (β₁ i)] [Π i, has_zero (β₂ i)]
  [Π i, decidable_pred (eq (0 : β₁ i))] [Π i, decidable_pred (eq (0 : β₂ i))] [comm_monoid γ]
  {f : Π i, β₁ i → β₂ i} {hf : ∀ i, f i 0 = 0} {g : Π₀ i, β₁ i} {h : Π i, β₂ i → γ} (h0 : ∀i, h i 0 = 1) :
  (map_range f hf g).prod h = g.prod (λi b, h i (f i b)) :=
begin
  rw [map_range_def],
  refine (finset.prod_subset support_mk_subset _).trans _,
  { intros i h1 h2,
    dsimp, simp [h1] at h2, dsimp at h2,
    simp [h1, h2, h0] },
  { refine finset.prod_congr rfl _,
    intros i h1,
    simp [h1] }
end

@[to_additive dfinsupp.sum_zero_index]
lemma prod_zero_index [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))] [comm_monoid γ]
  {h : Π i, β i → γ} : (0 : Π₀ i, β i).prod h = 1 :=
rfl

@[to_additive dfinsupp.sum_single_index]
lemma prod_single_index [Π i, has_zero (β i)] [Π i, decidable_pred (eq (0 : β i))] [comm_monoid γ]
  {i : ι} {b : β i} {h : Π i, β i → γ} (h_zero : h i 0 = 1) :
  (single i b).prod h = h i b :=
begin
  by_cases h : b = 0,
  { simp [h, prod_zero_index, h_zero], refl },
  { simp [dfinsupp.prod, support_single_ne_zero h] }
end

@[to_additive dfinsupp.sum_neg_index]
lemma prod_neg_index [Π i, add_group (β i)] [Π i, decidable_pred (eq (0 : β i))] [comm_monoid γ]
  {g : Π₀ i, β i} {h : Π i, β i → γ} (h0 : ∀i, h i 0 = 1) :
  (-g).prod h = g.prod (λi b, h i (- b)) :=
prod_map_range_index h0

@[simp] lemma sum_apply {ι₁ : Type u₁} [decidable_eq ι₁] {β₁ : ι₁ → Type v₁}
  [Π i₁, has_zero (β₁ i₁)] [Π i, decidable_pred (eq (0 : β₁ i))]
  [Π i, add_comm_monoid (β i)]
  {f : Π₀ i₁, β₁ i₁} {g : Π i₁, β₁ i₁ → Π₀ i, β i} {i₂ : ι} :
  (f.sum g) i₂ = f.sum (λi₁ b, g i₁ b i₂) :=
(finset.sum_hom (λf : Π₀ i, β i, f i₂)).symm

lemma support_sum {ι₁ : Type u₁} [decidable_eq ι₁] {β₁ : ι₁ → Type v₁}
  [Π i₁, has_zero (β₁ i₁)] [Π i, decidable_pred (eq (0 : β₁ i))]
  [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  {f : Π₀ i₁, β₁ i₁} {g : Π i₁, β₁ i₁ → Π₀ i, β i} :
  (f.sum g).support ⊆ f.support.bind (λi, (g i (f i)).support) :=
have ∀i₁ : ι, f.sum (λ (i : ι₁) (b : β₁ i), (g i b) i₁) ≠ 0 →
    (∃ (i : ι₁), f i ≠ 0 ∧ ¬ (g i (f i)) i₁ = 0),
  from assume i₁ h,
  let ⟨i, hi, ne⟩ := finset.exists_ne_zero_of_sum_ne_zero h in
  ⟨i, (f.mem_support_iff i).mp hi, ne⟩,
by simpa [finset.subset_iff, mem_support_iff, finset.mem_bind, sum_apply] using this

@[simp] lemma sum_zero [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [add_comm_monoid γ] {f : Π₀ i, β i} :
  f.sum (λi b, (0 : γ)) = 0 :=
finset.sum_const_zero

@[simp] lemma sum_add [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [add_comm_monoid γ] {f : Π₀ i, β i} {h₁ h₂ : Π i, β i → γ} :
  f.sum (λi b, h₁ i b + h₂ i b) = f.sum h₁ + f.sum h₂ :=
finset.sum_add_distrib

@[simp] lemma sum_neg [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [add_comm_group γ] {f : Π₀ i, β i} {h : Π i, β i → γ} :
  f.sum (λi b, - h i b) = - f.sum h :=
finset.sum_hom (@has_neg.neg γ _)

@[to_additive dfinsupp.sum_add_index]
lemma prod_add_index [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [comm_monoid γ] {f g : Π₀ i, β i}
  {h : Π i, β i → γ} (h_zero : ∀i, h i 0 = 1) (h_add : ∀i b₁ b₂, h i (b₁ + b₂) = h i b₁ * h i b₂) :
  (f + g).prod h = f.prod h * g.prod h :=
have f_eq : (f.support ∪ g.support).prod (λi, h i (f i)) = f.prod h,
  from (finset.prod_subset (finset.subset_union_left _ _) $
    by simp [mem_support_iff, h_zero] {contextual := tt}).symm,
have g_eq : (f.support ∪ g.support).prod (λi, h i (g i)) = g.prod h,
  from (finset.prod_subset (finset.subset_union_right _ _) $
    by simp [mem_support_iff, h_zero] {contextual := tt}).symm,
calc (f + g).support.prod (λi, h i ((f + g) i)) =
      (f.support ∪ g.support).prod (λi, h i ((f + g) i)) :
    finset.prod_subset support_add $
      by simp [mem_support_iff, h_zero] {contextual := tt}
  ... = (f.support ∪ g.support).prod (λi, h i (f i)) *
      (f.support ∪ g.support).prod (λi, h i (g i)) :
    by simp [h_add, finset.prod_mul_distrib]
  ... = _ : by rw [f_eq, g_eq]

lemma sum_sub_index [Π i, add_comm_group (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [add_comm_group γ] {f g : Π₀ i, β i}
  {h : Π i, β i → γ} (h_sub : ∀i b₁ b₂, h i (b₁ - b₂) = h i b₁ - h i b₂) :
  (f - g).sum h = f.sum h - g.sum h :=
have h_zero : ∀i, h i 0 = 0,
  from assume i,
  have h i (0 - 0) = h i 0 - h i 0, from h_sub i 0 0,
  by simpa using this,
have h_neg : ∀i b, h i (- b) = - h i b,
  from assume i b,
  have h i (0 - b) = h i 0 - h i b, from h_sub i 0 b,
  by simpa [h_zero] using this,
have h_add : ∀i b₁ b₂, h i (b₁ + b₂) = h i b₁ + h i b₂,
  from assume i b₁ b₂,
  have h i (b₁ - (- b₂)) = h i b₁ - h i (- b₂), from h_sub i b₁ (-b₂),
  by simpa [h_neg] using this,
by simp [@sum_add_index ι β _ γ _ _ _ f (-g) h h_zero h_add];
simp [@sum_neg_index ι β _ γ _ _ _ g h h_zero, h_neg];
simp [@sum_neg ι β _ γ _ _ _ g h]

@[to_additive dfinsupp.sum_finset_sum_index]
lemma prod_finset_sum_index {γ : Type w} {α : Type x}
  [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [comm_monoid γ] [decidable_eq α]
  {s : finset α} {g : α → Π₀ i, β i}
  {h : Π i, β i → γ} (h_zero : ∀i, h i 0 = 1) (h_add : ∀i b₁ b₂, h i (b₁ + b₂) = h i b₁ * h i b₂):
  s.prod (λi, (g i).prod h) = (s.sum g).prod h :=
finset.induction_on s
  (by simp [prod_zero_index])
  (by simp [prod_add_index, h_zero, h_add] {contextual := tt})

@[to_additive dfinsupp.sum_sum_index]
lemma prod_sum_index  {ι₁ : Type u₁} [decidable_eq ι₁] {β₁ : ι₁ → Type v₁}
  [Π i₁, has_zero (β₁ i₁)] [Π i, decidable_pred (eq (0 : β₁ i))]
  [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [comm_monoid γ]
  {f : Π₀ i₁, β₁ i₁} {g : Π i₁, β₁ i₁ → Π₀ i, β i}
  {h : Π i, β i → γ} (h_zero : ∀i, h i 0 = 1) (h_add : ∀i b₁ b₂, h i (b₁ + b₂) = h i b₁ * h i b₂):
  (f.sum g).prod h = f.prod (λi b, (g i b).prod h) :=
(prod_finset_sum_index h_zero h_add).symm

@[simp] lemma sum_single [Π i, add_comm_monoid (β i)]
  [Π i, decidable_pred (eq (0 : β i))] {f : Π₀ i, β i} :
  f.sum single = f :=
begin
  apply dfinsupp.induction f, {rw [sum_zero_index]},
  intros i b f H hb ih,
  rw [sum_add_index, ih, sum_single_index],
  all_goals { intros, simp }
end

@[to_additive dfinsupp.sum_subtype_domain_index]
lemma prod_subtype_domain_index [Π i, has_zero (β i)] [Π i, decidable_pred (eq (0 : β i))]
  [comm_monoid γ] {v : Π₀ i, β i} {p : ι → Prop} [decidable_pred p]
  {h : Π i, β i → γ} (hp : ∀x∈v.support, p x) :
  (v.subtype_domain p).prod (λi b, h i.1 b) = v.prod h :=
finset.prod_bij (λp _, p.val)
  (by simp)
  (by simp)
  (assume ⟨a₀, ha₀⟩ ⟨a₁, ha₁⟩, by simp)
  (λ i hi, ⟨⟨i, hp i hi⟩, by simpa using hi, rfl⟩)

lemma subtype_domain_sum [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  {s : finset γ} {h : γ → Π₀ i, β i} {p : ι → Prop} [decidable_pred p] :
  (s.sum h).subtype_domain p = s.sum (λc, (h c).subtype_domain p) :=
eq.symm (finset.sum_hom _)

lemma subtype_domain_finsupp_sum {δ : γ → Type x} [decidable_eq γ]
  [Π c, has_zero (δ c)] [Π c, decidable_pred (eq (0 : δ c))]
  [Π i, add_comm_monoid (β i)] [Π i, decidable_pred (eq (0 : β i))]
  {p : ι → Prop} [decidable_pred p]
  {s : Π₀ c, δ c} {h : Π c, δ c → Π₀ i, β i} :
  (s.sum h).subtype_domain p = s.sum (λc d, (h c d).subtype_domain p) :=
subtype_domain_sum

end prod_and_sum

end dfinsupp


import feather_logic.basic
import order.extension.well

universe u

/-!
In this file, we construct the type of feather terms in our model,
given the previous level of the model.
-/

namespace feather_model

open_locale classical

/--
A term in our model, parametrised by the type of terms in the previous level of the model.

* `var v` is the term representing the variable `v`.
* `prev e` is a term `e` from the previous level of the model.
* `univ` represents all of `Type u`.
* `ty α` is the Lean type `α`.
* `obj α x` is a Lean object of type `α` and value `x : α`.
* `apply f x` is the term representing function application of `f` on `x`.

If we are in level `u` of the model, `ty` represents feather objects of type `Type u`, and `obj`
represents feather objects of type which lies in `Type u`. Notably, `var` is a variable of feather
objects of type `Type u` or of type which lies in `Type u`. If smaller universes are needed, wrap
them in `prev`.

Some "error states" representing invalid situations are encoded as `ty pempty`.
-/
inductive mterm (T : Type u) : Type (u + 1)
| var : V → mterm
| prev : T → mterm
| univ : mterm
| ty : Type u → mterm
| obj : Π (α : Type u), α → mterm
| apply : mterm → mterm → mterm

/-- Provides the `has_type` function, which determines if a given term has a given type.
This is just used for bookkeeping between levels of the model. -/
class type_data (α : Type*) :=
(has_type : α → α → Prop)
(is_type : α → Prop)

variables {T : Type u} [term_struct T]

namespace mterm

def bound : Π (e : mterm T), finset V
| (var v) := {v}
| (prev e) := term_struct.bound e
| univ := ∅
| (ty α) := ∅
| (obj α x) := ∅
| (apply f x) := bound f ∪ bound x

-- A convenient instance to use instead of explicitly calling `bound` all the time.
instance mterm_has_mem : has_mem V (mterm T) := ⟨λ v e, v ∈ bound e⟩

def subst (v : V) : Π (e : mterm T) (f : mterm T), mterm T
| e (var w) := if v = w then e else var w
| (prev e) (prev f) := prev (term_struct.subst v e f)
| _ (prev f) := ty pempty
| e univ := univ
| e (ty α) := ty α
| e (obj α x) := obj α x
| e (apply f x) := apply (subst e f) (subst e x)

def has_type [type_data T] : Π (e f : mterm T), Prop
| (prev x) (prev α) := type_data.has_type x α
| (ty α) univ := true
| (obj α x) (ty β) := α = β
| _ _ := false

def is_type [type_data T] : Π (e : mterm T), Prop
| (prev α) := type_data.is_type α
| (ty α) := true
| _ := false

instance mterm.type_data [type_data T] : type_data (mterm T) := ⟨has_type, is_type⟩

end mterm

open mterm

section interpretation

/-! Given a context, which here means a  `finset (V × mterm T)`, we produce the set of all
*interpretations* of that context: substitutions of Lean objects for these variables
that satisfy the given context. -/

/--
We establish a relation on judgments `V × mterm T`.
If `v` occurs bound in a term `f`, then `(v, e)` must precede `(w, f)`.

On a plain context `finset (V × mterm T)`, if the transitive closure of this relation forms a
strict partial order, we can sort the judgments and provide a set of interpretations for it by
iteratively substituting along this order.
-/
def immediately_precedes (a b : V × mterm T) : Prop := a.1 ∈ b.2

/-- A list of substitutions to perform to yield a interpretation of a collection of variables. -/
@[reducible] def interpretation (T : Type u) := list (V × mterm T)

/-- Given an interpretation, evaluate this term. -/
def interpretation.interpret (I : interpretation T) (e : mterm T) : mterm T :=
list.foldl (λ (f : mterm T) (i : V × mterm T), subst i.1 i.2 f) e I

/-- A collection of assumptions `V × mterm T` is *sortable* if they can be ordered in such a way
where each variable occurs only in substitutions later in the order. -/
def interpretation.sortable (C : finset (V × mterm T)) : Prop :=
well_founded (λ a b : C, immediately_precedes a.val b.val)

/-- Assuming a context is sortable, produce a linear order for it. -/
noncomputable def interpretation.sort_order (C : finset (V × mterm T))
  (h : interpretation.sortable C) : linear_order C :=
well_founded.well_order_extension h

/-- Assuming that a context is sortable, sort it. The precise sort chosen is arbitrary. -/
noncomputable def interpretation.sort (C : finset (V × mterm T)) (h : interpretation.sortable C) :
  list (V × mterm T) :=
(finset.sort (interpretation.sort_order C h).le C.attach).map subtype.val

/-- Substitutes the term `e` for the variable `v`. If the context contains an assumption `v : α`,
it is removed. -/
def interpretation.subst (v : V) (e : mterm T) (I : list (V × mterm T)) : list (V × mterm T) :=
(I.filter (λ x : V × mterm T, x.1 = v)).map (prod.map id (subst v e))

lemma interpretation.subst_length (v : V) (e : mterm T) (I : interpretation T) :
  (interpretation.subst v e I).length ≤ I.length :=
begin
  unfold interpretation.subst,
  rw list.length_map,
  exact list.length_filter_le _ _,
end

/-- The set of interpretations of a typing judgment `e : type`. -/
def interpretations (v : V) : Π (type : mterm T), set (interpretation T)
| (ty α) := ⋃ (x : α), {[⟨v, mterm.obj α x⟩]}
| _ := ∅

def interpretations' : Π (C : list (V × mterm T)), set (interpretation T)
| [] := {[]}
| (x :: xs) := ⋃ (I ∈ interpretations x.1 x.2),
    have (interpretation.subst x.1 x.2 xs).length < (x :: xs).length,
    from lt_of_le_of_lt (interpretation.subst_length x.1 x.2 xs) (lt_add_one _),
    (λ J, I ++ J) '' interpretations' (interpretation.subst x.1 x.2 xs)
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf list.length⟩] }

def rir_context.interpretations (C : rir_context (mterm T)) : set (interpretation T) :=
if h : interpretation.sortable (C.Γ ∪ C.Ξ)
then interpretations' (interpretation.sort _ h) else ∅

def runtime_context.interpretations (C : runtime_context (mterm T)) : set (interpretation T) :=
if h : interpretation.sortable (C.Γ ∪ C.Θ.to_finset ∪ C.Ξ)
then interpretations' (interpretation.sort _ h) else ∅

end interpretation

def is_type [type_data T] (C : rir_context (mterm T)) (α : mterm T) : Prop :=
∀ (I : interpretation T), I ∈ C.interpretations → mterm.is_type (I.interpret α)

inductive runtime_ok [type_data T] : runtime_context (mterm T) → Prop
| empty : runtime_ok ⟨∅, ∅, ∅⟩
| Γ (C : runtime_context (mterm T)) (v : V) (α : mterm T) :
  runtime_ok C → is_type C.rir α → runtime_ok (C + ⟨{(v, α)}, ∅, ∅⟩)
| Θ (C : runtime_context (mterm T)) (v : V) (α : mterm T) :
  runtime_ok C → is_type C.rir α → runtime_ok (C + ⟨∅, {(v, α)}, ∅⟩)
| Ξ (C : runtime_context (mterm T)) (v : V) (α : mterm T) :
  runtime_ok C → is_type C.rir α → runtime_ok (C + ⟨∅, ∅, {(v, α)}⟩)

inductive rir_ok [type_data T] : rir_context (mterm T) → Prop
| empty : rir_ok ⟨∅, ∅⟩
| Γ (C : rir_context (mterm T)) (v : V) (α : mterm T) :
  rir_ok C → is_type C α → rir_ok (C ∪ ⟨{(v, α)}, ∅⟩)
| Ξ (C : rir_context (mterm T)) (v : V) (α : mterm T) :
  rir_ok C → is_type C α → rir_ok (C ∪ ⟨∅, {(v, α)}⟩)

-- TODO: Add the assertion that we use the relevant resources in `Θ` only once, and that relevant
-- things are representable.
structure runtime_judgments [type_data T] (J : runtime_judgment (mterm T)) : Prop :=
(ok : runtime_ok J.ctx)
(interpret : ∀ (I : interpretation T), I ∈ J.ctx.interpretations →
  (I.interpret J.e).has_type (I.interpret J.type))

structure rir_judgments [type_data T] (J : rir_judgment (mterm T)) : Prop :=
(ok : rir_ok J.ctx)
(interpret : ∀ (I : interpretation T), I ∈ J.ctx.interpretations →
  (I.interpret J.e).has_type (I.interpret J.type))

def defeq [type_data T] (C : rir_context (mterm T)) (x y α : mterm T) : Prop :=
∀ (I : interpretation T), I ∈ C.interpretations →
  I.interpret x = I.interpret y ∧ (I.interpret x).has_type (I.interpret α)

def sort : sort_name → mterm T
| (sort_name.type n) := ty pempty
| sort_name.prop := ty (ulift Prop)
| sort_name.region := ty punit

def representable (C : finset (V × mterm T)) (e : mterm T) : mterm T :=
mterm.obj (ulift Prop) ⟨false⟩

instance [type_data T] : term_struct (mterm T) := {
  var := var,
  bound := bound,
  subst := subst,
  is_type := is_type,
  runtime_ok := runtime_ok,
  rir_ok := rir_ok,
  runtime_judgments := runtime_judgments,
  rir_judgments := rir_judgments,
  defeq := defeq,
  sort := sort,
  representable := representable,
}

end feather_model


-- From page 9-10 of Baghery et al., we take the coefficients of the relevant monomials.

-- lemma coeff1122 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   polynomial.C A_α * polynomial.C B_β = 1
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   -- done,
--   -- simp only [] with polynomial_nf_3 at eqdn,
--   -- simp only [mul_add, add_mul, finset.sum_add_distrib, C_mul_C, finset.sum_hom, mul_assoc, mul_sum_symm,rearrange_constants_right, rearrange_constants_right_with_extra, rearrange_sums_right, rearrange_sums_right_with_extra] at eqn,
--   have congr_coeff1122 := congr_arg (coeff (single vars.α 1 + single vars.β 1 + single vars.δ 2 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff1122,
--   simp only [] with finsupp_simp at congr_coeff1122,
--   exact congr_coeff1122,
-- end

-- lemma coeff0222 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--  polynomial.C A_β * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0222 := congr_arg (coeff (single vars.α 0 + single vars.β 2 + single vars.δ 2 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0222,
--   simp only [] with finsupp_simp at  congr_coeff0222,
--   exact congr_coeff0222,
-- end

-- lemma coeff1023 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   polynomial.C A_α * polynomial.C B_γ = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff1023 := congr_arg (coeff (single vars.α 1 + single vars.β 0 + single vars.δ 2 + single vars.γ 3)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff1023,
--   simp only [] with finsupp_simp at  congr_coeff1023,
--   exact congr_coeff1023,
-- end

-- lemma coeff0212 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--    (∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (A_m x)) * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0212 := congr_arg (coeff (single vars.α 0 + single vars.β 2 + single vars.δ 1 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0212,
--   simp only [] with finsupp_simp at  congr_coeff0212,
--   exact congr_coeff0212,
-- end

-- lemma coeff1112 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_wit) in finset.fin_range n_wit, v_wit x * polynomial.C (A_m x)) * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff1112 := congr_arg (coeff (single vars.α 1 + single vars.β 1 + single vars.δ 1 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff1112,
--   simp only [] with finsupp_simp at  congr_coeff1112,
--   exact congr_coeff1112,
-- end

-- lemma coeff0112 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (A_m x)) *
--           ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ) +
--         (∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (A_m x)) * polynomial.C B_β +
--       (∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1), polynomial.X ^ (x : ℕ) * t * polynomial.C (A_h x)) *
--         polynomial.C B_β =
--     0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0112 := congr_arg (coeff (single vars.α 0 + single vars.β 1 + single vars.δ 1 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0112,
--   simp only [] with finsupp_simp at  congr_coeff0112,
--   exact congr_coeff0112,
-- end

-- lemma coeff0012 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (A_m x)) * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ) + (∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1), polynomial.X ^ (x : ℕ) * t * polynomial.C (A_h x)) * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ ) = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0012 := congr_arg (coeff (single vars.α 0 + single vars.β 0 + single vars.δ 1 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0012,
--   simp only [] with finsupp_simp at  congr_coeff0012,
--   exact congr_coeff0012,
-- end

-- lemma coeff0221 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--    (∑ (x : fin n_stmt) in finset.fin_range n_stmt, u_stmt x * polynomial.C (A_l x)) * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0221 := congr_arg (coeff (single vars.α 0 + single vars.β 2 + single vars.δ 2 + single vars.γ 1)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0221,
--   simp only [] with finsupp_simp at  congr_coeff0221,
--   exact congr_coeff0221,
-- end

-- lemma coeff1121 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_stmt) in finset.fin_range n_stmt, v_stmt x * polynomial.C (A_l x)) * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff1121 := congr_arg (coeff (single vars.α 1 + single vars.β 1 + single vars.δ 2 + single vars.γ 1)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff1121,
--   simp only [] with finsupp_simp at  congr_coeff1121,
--   exact congr_coeff1121,
-- end

-- lemma coeff0121 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_stmt) in finset.fin_range n_stmt, u_stmt x * polynomial.C (A_l x)) * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ) + (∑ (x : fin n_stmt) in finset.fin_range n_stmt, w_stmt x * polynomial.C (A_l x)) * polynomial.C B_β = 0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0121 := congr_arg (coeff (single vars.α 0 + single vars.β 1 + single vars.δ 2 + single vars.γ 1)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0121,
--   simp only [] with finsupp_simp at  congr_coeff0121,
--   exact congr_coeff0121,
-- end

-- lemma coeff0021 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (x : fin n_stmt) in finset.fin_range n_stmt, w_stmt x * polynomial.C (A_l x)) *
--       ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : nat) =
--     0
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0021 := congr_arg (coeff (single vars.α 0 + single vars.β 0 + single vars.δ 2 + single vars.γ 1)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0021,
--   simp only [] with finsupp_simp at  congr_coeff0021,
--   exact congr_coeff0021,
-- end

-- lemma coeff0122 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   polynomial.C A_β * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ) + (∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (A_x i) * polynomial.X ^ (i : ℕ)) * polynomial.C B_β + (∑ (x : fin n_stmt) in finset.fin_range n_stmt, u_stmt x * polynomial.C (A_l x)) * polynomial.C B_γ + (∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (A_m x)) * polynomial.C B_δ
--   = ∑ (x : fin n_stmt) in finset.fin_range n_stmt, polynomial.C (a_stmt x) * u_stmt x + ∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (C_m x)
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0122 := congr_arg (coeff (single vars.α 0 + single vars.β 1 + single vars.δ 2 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0122,
--   simp only [] with finsupp_simp at  congr_coeff0122,
--   exact congr_coeff0122,
-- end

-- lemma coeff1022 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
-- polynomial.C A_α * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ ) + (∑ (x : fin n_stmt) in finset.fin_range n_stmt, v_stmt x * polynomial.C (A_l x)) * polynomial.C B_γ + (∑ (x : fin n_wit) in finset.fin_range n_wit, v_wit x * polynomial.C (A_m x)) * polynomial.C B_δ = ∑ (x : fin n_stmt) in finset.fin_range n_stmt, polynomial.C (a_stmt x) * v_stmt x + ∑ (x : fin n_wit) in finset.fin_range n_wit, v_wit x * polynomial.C (C_m x)
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff1022 := congr_arg (coeff (single vars.α 1 + single vars.β 0 + single vars.δ 2 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff1022,
--   simp only [] with finsupp_simp at  congr_coeff1022,
--   exact congr_coeff1022,
-- end

-- lemma coeff0022 (a_stmt : fin n_stmt → F) (eqn : verified' a_stmt) :
--   (∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (A_x i) * polynomial.X ^ (i : ℕ)) * ∑ (i : fin n_var) in finset.fin_range n_var, polynomial.C (B_x i) * polynomial.X ^ (i : ℕ) + (∑ (x : fin n_stmt) in finset.fin_range n_stmt, w_stmt x * polynomial.C (A_l x)) * polynomial.C B_γ + (∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (A_m x)) * polynomial.C B_δ + (∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1), polynomial.X ^ (x : ℕ) * t * polynomial.C (A_h x)) * polynomial.C B_δ = ∑ (x : fin n_stmt) in finset.fin_range n_stmt, polynomial.C (a_stmt x) * w_stmt x + (∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (C_m x) + ∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1), polynomial.X ^ (x : ℕ) * t * polynomial.C (C_h x))
-- :=
-- begin
--   rw verified' at eqn,
--   rw [A', B', C'] at eqn,
--   simp only [] with crs at eqn,
--   -- simp only [] with polynomial_nf_3 at eqn,
--   -- simp only [mv_polynomial.smul_eq_C_mul] at eqn,
--   simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn,
--   have congr_coeff0022 := congr_arg (coeff (single vars.α 0 + single vars.β 0 + single vars.δ 2 + single vars.γ 2)) eqn,
--   clear eqn,
--   simp only [finsupp_vars_eq_ext] with coeff_simp finsupp_eq at congr_coeff0022,
--   simp only [] with finsupp_simp at  congr_coeff0022,
--   exact congr_coeff0022,
-- end


import category_theory.abelian.projective
import for_mathlib.abelian_category

noncomputable theory

universes v u

open category_theory category_theory.limits

namespace category_theory

/-- `endomorphisms C` is the category whose objects are an object of `C` equipped with an
endomorphism. Morphisms are morphisms between objects which intertwine the endomorphisms. -/
structure endomorphisms (C : Type u) [category.{v} C] :=
(X : C)
(e : End X)

namespace endomorphisms

section category

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

@[ext] protected structure hom (X Y : endomorphisms C) :=
(f : X.X ⟶ Y.X)
(comm : X.e ≫ f = f ≫ Y.e)

attribute [reassoc, simp] hom.comm

instance (C : Type u) [category.{v} C] : quiver (endomorphisms C) :=
{ hom := λ X Y, hom X Y }

lemma f_injective (X Y : endomorphisms C) : function.injective (hom.f : (X ⟶ Y) → (X.X ⟶ Y.X)) :=
by { intros f g h, ext, exact h }

protected def id (X : endomorphisms C) : X ⟶ X :=
{ f := 𝟙 _,
  comm := by rw [category.comp_id, category.id_comp] }

protected def comp {X Y Z : endomorphisms C} (f : X ⟶ Y) (g : Y ⟶ Z) : X ⟶ Z :=
{ f := f.f ≫ g.f,
  comm := by simp only [hom.comm, hom.comm_assoc, category.assoc] }

instance (C : Type u) [category.{v} C] : category_struct (endomorphisms C) :=
{ id := λ X, X.id,
  comp := λ X Y Z f g, endomorphisms.comp f g }

@[simp] lemma id_f (X : endomorphisms C) : hom.f (𝟙 X) = 𝟙 X.X := rfl

@[simps]
def end_of_e (X : endomorphisms C) : X ⟶ X := ⟨X.e, rfl⟩

lemma end_of_e_comm {X Y : endomorphisms C} (g : X ⟶ Y) : X.end_of_e ≫ g =
  g ≫ Y.end_of_e :=
by { ext, apply endomorphisms.hom.comm, }

@[simp, reassoc] lemma comp_f {X Y Z : endomorphisms C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  hom.f (f ≫ g) = f.f ≫ g.f := rfl

instance (C : Type u) [category.{v} C] : category (endomorphisms C) :=
{ id_comp' := λ X Y f, by { ext1, simp only [comp_f, id_f, category.id_comp] },
  comp_id' := λ X Y f, by { ext1, simp only [comp_f, id_f, category.comp_id] },
  assoc' := λ X Y Z W f g h, by { ext1, simp only [comp_f, category.assoc] } }

lemma congr_f {X Y : endomorphisms C} (f₁ f₂ : X ⟶ Y) (h : f₁ = f₂) : f₁.f = f₂.f := by rw h

@[simp, reassoc] lemma pow_comm {X Y : endomorphisms C} (f : X ⟶ Y) (n : ℕ) :
  (X.e ^ n : End X.X) ≫ f.f = f.f ≫ (Y.e ^ n : End Y.X) :=
begin
  induction n with n ih,
  { simp only [pow_zero, End.one_def, category.id_comp, category.comp_id] },
  { simp only [nat.succ_eq_add_one, pow_succ, End.mul_def, category.assoc, hom.comm, reassoc_of ih] }
end

@[simps]
protected def forget (C : Type u) [category.{v} C] : endomorphisms C ⥤ C :=
{ obj := λ X, X.X,
  map := λ X Y f, f.f,
  map_id' := λ X, rfl,
  map_comp' := λ X Y Z f g, rfl }

lemma epi_of_epi_f {X Y : endomorphisms C} (f : X ⟶ Y) [epi f.f] : epi f :=
{ left_cancellation := λ Z g h w, begin
    ext, rw [← cancel_epi f.f, ← comp_f, w, comp_f],
  end }

def mk_iso {X Y : endomorphisms C} (e : X.X ≅ Y.X) (h : X.e ≫ e.hom = e.hom ≫ Y.e) : X ≅ Y :=
{ hom := ⟨e.hom, h⟩,
  inv := ⟨e.inv, by rw [e.comp_inv_eq, category.assoc, e.eq_inv_comp, h]⟩,
  hom_inv_id' := by { ext, simp only [comp_f, iso.hom_inv_id, id_f] },
  inv_hom_id' := by { ext, simp only [comp_f, iso.inv_hom_id, id_f] } }

end category

section limits

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

@[simps]
def twist_cone {K : J ⥤ endomorphisms C}
  (S : cone (K ⋙ endomorphisms.forget C)) :
  cone (K ⋙ endomorphisms.forget C) :=
{ X := S.X,
  π :=
  { app := λ j, S.π.app j ≫ (K.obj j).e,
    naturality' := begin
      intros i j f,
      dsimp,
      simp only [category.id_comp, category.assoc, hom.comm],
      erw S.w_assoc,
    end } }

abbreviation cone_e {K : J ⥤ endomorphisms C}
  (S : cone (K ⋙ endomorphisms.forget C)) (hS : is_limit S) :
  S.X ⟶ S.X :=
@is_limit.lift J _ C _ (K ⋙ endomorphisms.forget C) S hS (twist_cone S)

@[simps]
protected def cone {K : J ⥤ endomorphisms C}
  (S : cone (K ⋙ endomorphisms.forget C)) (hS : is_limit S) :
  cone K :=
{ X :=
  { X := S.X,
    e := cone_e S hS },
  π :=
  { app := λ j,
    { f := S.π.app _,
      comm := by { dsimp, simp } },
    naturality' := λ i j f, begin
      ext, dsimp, simp, erw S.w,
    end } }

@[simps]
protected def is_limit_cone {K : J ⥤ endomorphisms C}
  (S : cone (K ⋙ endomorphisms.forget C)) (hS : is_limit S) :
  is_limit (endomorphisms.cone S hS) :=
{ lift := λ S,
  { f := hS.lift ⟨S.X.X,
    { app := λ j, (S.π.app _).f,
      naturality' := begin
        intros i j f,
        dsimp,
        simp [← comp_f],
      end }⟩,
    comm := begin
      apply hS.hom_ext, dsimp, simp,
    end },
  fac' := begin
    intros s j, ext, dsimp, simp,
  end,
  uniq' := begin
    intros s m hm, ext, apply hS.hom_ext,
    intros j, specialize hm j, apply_fun (λ e, e.f) at hm,
    dsimp at *, simp [hm],
  end }

.

protected def cone_iso {K : J ⥤ endomorphisms C} (S : cone K)
  (hS : is_limit ((endomorphisms.forget C).map_cone S)) :
  endomorphisms.cone _ hS ≅ S :=
cones.ext
({ hom :=
  { f := 𝟙 _,
    comm := by { apply hS.hom_ext, intros j, dsimp, simp, erw hS.fac, dsimp, simp, } },
  inv :=
  { f := 𝟙 _,
    comm := by { apply hS.hom_ext, intros j, dsimp, simp, erw hS.fac, dsimp, simp } },
  hom_inv_id' := by { ext, dsimp, simp },
  inv_hom_id' := by { ext, dsimp, simp } })
begin
  intros j, ext,
  dsimp, simp,
end

protected def cone_iso' {K : J ⥤ endomorphisms C}
  (S : cone (K ⋙ endomorphisms.forget C)) (hS : is_limit S) :
  (endomorphisms.forget C).map_cone (endomorphisms.cone S hS) ≅ S :=
cones.ext
(iso.refl _)
begin
  intros j,
  dsimp,
  simp,
end

instance has_limit (K : J ⥤ endomorphisms C) [has_limit (K ⋙ endomorphisms.forget C)] :
  has_limit K :=
⟨⟨⟨_, endomorphisms.is_limit_cone _ (limit.is_limit _)⟩⟩⟩

instance has_limits_of_shape [has_limits_of_shape J C] :
  has_limits_of_shape J (endomorphisms C) := ⟨⟩

instance has_limits [has_limits C] : has_limits (endomorphisms C) := ⟨⟩

instance creates_limit (K : J ⥤ endomorphisms C) : creates_limit K (endomorphisms.forget _) :=
{ reflects := λ S hS, is_limit.of_iso_limit (endomorphisms.is_limit_cone _ _)
    (endomorphisms.cone_iso _ hS),
  lifts := λ S hS,
  { lifted_cone := endomorphisms.cone _ hS,
    valid_lift := endomorphisms.cone_iso' _ _ } }

instance preserves_limit (K : J ⥤ endomorphisms C) [has_limit (K ⋙ endomorphisms.forget C)] :
  preserves_limit K (endomorphisms.forget C) :=
category_theory.preserves_limit_of_creates_limit_and_has_limit K (endomorphisms.forget C)

instance preserves_limits_of_shape [has_limits_of_shape J C] :
  preserves_limits_of_shape J (endomorphisms.forget C) := ⟨⟩

instance preserves_limits [has_limits C] : preserves_limits (endomorphisms.forget C) := ⟨⟩

instance [has_finite_limits C] : preserves_finite_limits (endomorphisms.forget C) :=
by { constructor, introsI J hJ1 hJ2, apply_instance }

end limits

section colimits

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

@[simps]
def twist_cocone {K : J ⥤ endomorphisms C}
  (S : cocone (K ⋙ endomorphisms.forget C)) :
  cocone (K ⋙ endomorphisms.forget C) :=
{ X := S.X,
  ι :=
  { app := λ j, (K.obj j).e ≫ S.ι.app j,
    naturality' := begin
      intros i j f,
      dsimp,
      simp only [category.comp_id, ← hom.comm_assoc],
      erw S.w,
    end } }

abbreviation cocone_e {K : J ⥤ endomorphisms C}
  (S : cocone (K ⋙ endomorphisms.forget C)) (hS : is_colimit S) :
  S.X ⟶ S.X :=
@is_colimit.desc J _ C _ (K ⋙ endomorphisms.forget C) S hS (twist_cocone S)

@[simps]
protected def cocone {K : J ⥤ endomorphisms C}
  (S : cocone (K ⋙ endomorphisms.forget C)) (hS : is_colimit S) :
  cocone K :=
{ X :=
  { X := S.X,
    e := cocone_e S hS },
  ι :=
  { app := λ j,
    { f := S.ι.app j,
      comm := by { dsimp, simp } },
    naturality' := λ i j f, begin
      ext, dsimp, simp, erw S.w,
    end } }

@[simps]
protected def is_colimit_cocone {K : J ⥤ endomorphisms C}
  (S : cocone (K ⋙ endomorphisms.forget C)) (hS : is_colimit S) :
  is_colimit (endomorphisms.cocone S hS) :=
{ desc := λ S,
  { f := hS.desc ⟨S.X.X,
    { app := λ j, (S.ι.app j).f,
      naturality' := begin
        intros i j f,
        dsimp,
        simp [← comp_f],
      end }⟩,
    comm := begin
      apply hS.hom_ext, dsimp, simp,
    end },
  fac' := begin
    intros s j, ext, dsimp, simp,
  end,
  uniq' := begin
    intros s m hm, ext, apply hS.hom_ext,
    intros j, specialize hm j, apply_fun (λ e, e.f) at hm,
    dsimp at *, simp [hm],
  end }

.

protected def cocone_iso {K : J ⥤ endomorphisms C} (S : cocone K)
  (hS : is_colimit ((endomorphisms.forget C).map_cocone S)) :
  endomorphisms.cocone _ hS ≅ S :=
cocones.ext
({ hom :=
  { f := 𝟙 _,
    comm := by { apply hS.hom_ext, intros j, dsimp, simp, erw hS.fac, dsimp, simp, } },
  inv :=
  { f := 𝟙 _,
    comm := by { apply hS.hom_ext, intros j, dsimp, simp, erw hS.fac, dsimp, simp } },
  hom_inv_id' := by { ext, dsimp, simp },
  inv_hom_id' := by { ext, dsimp, simp } })
begin
  intros j, ext,
  dsimp, simp,
end

protected def cocone_iso' {K : J ⥤ endomorphisms C}
  (S : cocone (K ⋙ endomorphisms.forget C)) (hS : is_colimit S) :
  (endomorphisms.forget C).map_cocone (endomorphisms.cocone S hS) ≅ S :=
cocones.ext
(iso.refl _)
begin
  intros j,
  dsimp,
  simp,
end

instance has_colimit (K : J ⥤ endomorphisms C) [has_colimit (K ⋙ endomorphisms.forget C)] :
  has_colimit K :=
⟨⟨⟨_, endomorphisms.is_colimit_cocone _ (colimit.is_colimit _)⟩⟩⟩

instance has_colimits_of_shape [has_colimits_of_shape J C] :
  has_colimits_of_shape J (endomorphisms C) := ⟨⟩

instance has_colimits [has_colimits C] : has_colimits (endomorphisms C) := ⟨⟩

instance creates_colimit (K : J ⥤ endomorphisms C) : creates_colimit K (endomorphisms.forget _) :=
{ reflects := λ S hS, is_colimit.of_iso_colimit (endomorphisms.is_colimit_cocone _ _)
    (endomorphisms.cocone_iso _ hS),
  lifts := λ S hS,
  { lifted_cocone := endomorphisms.cocone _ hS,
    valid_lift := endomorphisms.cocone_iso' _ _ } }

instance preserves_colimit (K : J ⥤ endomorphisms C) [has_colimit (K ⋙ endomorphisms.forget C)] :
  preserves_colimit K (endomorphisms.forget C) :=
category_theory.preserves_colimit_of_creates_colimit_and_has_colimit K (endomorphisms.forget C)

instance preserves_colimits_of_shape [has_colimits_of_shape J C] :
  preserves_colimits_of_shape J (endomorphisms.forget C) := ⟨⟩

instance preserves_colimits [has_colimits C] : preserves_colimits (endomorphisms.forget C) := ⟨⟩

instance [has_finite_colimits C] : preserves_finite_colimits (endomorphisms.forget C) :=
by { constructor, introsI J hJ1 hJ2, apply_instance }

end colimits

section projectives

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

section free

variable [has_coproducts_of_shape (ulift.{v} ℕ) C]

/-- `free X` is ⨁ₙX, the direct sum over the naturals, equipped with the endomorphism
sending `(a : X)` in degree `n` to `a` in degree `n+1`. An alternative way to view `free X`
is `X ⨂_{ℤ} ℤ[T]` with the endomorphism given by multiplication by `T`. -/
@[simps]
def free (X : C) : endomorphisms C :=
{ X := ∐ (λ i : ulift.{v} ℕ, X),
  e := sigma.desc $ λ i, sigma.ι (λ i : ulift.{v} ℕ, X) ⟨i.down + 1⟩ }

@[reassoc] lemma free.ι_comp_e (X : C) (i : ulift.{v} ℕ) :
  sigma.ι (λ i : ulift.{v} ℕ, X) i ≫ (free X).e = sigma.ι (λ i : ulift.{v} ℕ, X) ⟨i.down + 1⟩ :=
begin
  dsimp, simp only [colimit.ι_desc, cofan.mk_ι_app],
end

@[ext] lemma free.ext {X : C} {A : endomorphisms C} (f g : free X ⟶ A)
  (w : sigma.ι (λ i : ulift.{v} ℕ, X) ⟨0⟩ ≫ f.f = sigma.ι (λ i : ulift.{v} ℕ, X) ⟨0⟩ ≫ g.f) :
  f = g :=
begin
  ext ⟨i⟩, dsimp,
  induction i with i ih, { exact w },
  apply_fun (λ α, α ≫ A.e) at ih,
  simp only [category.assoc, ← hom.comm, free.ι_comp_e_assoc] at ih,
  exact ih,
end

/-- The map `free T ⟶ A` in `endomorphisms C` induced by a map `T ⟶ A.X` in `C`. Here `A.X`
is the forgetful functor forgetting the endomorphism. -/
@[simps]
def free.desc {X : C} {A : endomorphisms C} (f : X ⟶ A.X) : free X ⟶ A :=
{ f := sigma.desc $ λ i, f ≫ (A.e ^ i.down : End A.X),
  comm := begin
    ext1 ⟨i⟩, dsimp,
    simp only [colimit.ι_desc_assoc, cofan.mk_ι_app,
      colimit.ι_desc, category.assoc, pow_succ, End.mul_def],
  end }

lemma free.desc_comp {X : C} {A B : endomorphisms C} (f : X ⟶ A.X) (g : A ⟶ B) :
  free.desc f ≫ g = free.desc (f ≫ g.f) :=
begin
  ext1, dsimp,
  simp only [colimit.ι_desc_assoc, cofan.mk_ι_app, colimit.ι_desc, category.assoc, pow_comm],
end

def free.map {X Y : C} (f : X ⟶ Y) : free X ⟶ free Y :=
{ f := sigma.desc $ λ i, f ≫ sigma.ι (λ i : ulift.{v} ℕ, Y) i,
  comm := begin
    ext1 ⟨i⟩,
    dsimp,
    simp only [colimit.ι_desc_assoc, cofan.mk_ι_app, colimit.ι_desc, category.assoc],
  end }

variable (C)

def functor.free : C ⥤ endomorphisms C :=
{ obj := free,
  map := λ _ _, free.map,
  map_id' := λ X, begin ext, dsimp, simp only [free.map, category.id_comp, colimit.ι_desc,
    cofan.mk_ι_app, category.comp_id], end,
  map_comp' := λ X Y Z f g, begin ext, dsimp, simp only [free.map, category.assoc, colimit.ι_desc,
    cofan.mk_ι_app, colimit.ι_desc_assoc], end }

end free

section cofree

variable {C}
variable [has_products_of_shape (ulift.{v} ℕ) C]

/-- `cofree X` is ∏ₙX, the product over the naturals, equipped with the endomorphism
sending `(a : X)` in degree `n` to `a` in degree `n+1`. -/
def cofree (X : C) : endomorphisms C :=
{ X := ∏ (λ i : ulift.{v} ℕ, X),
  e := pi.lift $ λ i, pi.π _ ⟨i.down + 1⟩ }

def cofree.lift {X : C} {A : endomorphisms C} (f : A.X ⟶ X) :
  A ⟶ cofree X :=
{ f := pi.lift $ λ i, (A.e ^ i.down : End A.X) ≫ f,
  comm := begin
    dsimp [cofree],
    ext ⟨j⟩, dsimp,
    simp only [category.assoc, limit.lift_π, fan.mk_π_app],
    rw [← category.assoc, pow_succ, ← End.mul_def], congr' 1,
    induction j with j hj,
    { simp },
    { simp only [End.mul_def, pow_succ] at *,
      simp [reassoc_of hj] }
  end }

end cofree

variables [has_products_of_shape (ulift.{v} ℕ) C] [has_coproducts_of_shape (ulift.{v} ℕ) C]

lemma f_epi {X Y : endomorphisms C} (f : X ⟶ Y) [epi f] : epi f.f :=
{ left_cancellation := λ Z g h w, begin
    let gg : Y ⟶ cofree Z := cofree.lift g,
    let hh : Y ⟶ cofree Z := cofree.lift h,
    have : f ≫ gg = f ≫ hh,
    { ext, dsimp [gg, hh, cofree.lift], simp,
      simp_rw [← category.assoc, ← pow_comm, category.assoc, w] },
    rw cancel_epi at this,
    apply_fun (λ e, e.f ≫ pi.π (λ i : ulift.{v} ℕ, Z) (ulift.up 0)) at this,
    dsimp [gg, hh, cofree.lift] at this, simpa using this,
  end }

lemma f_mono {X Y : endomorphisms C} (f : X ⟶ Y) [mono f] : mono f.f :=
{ right_cancellation := λ Z g h w, begin
    let gg : free Z ⟶ X := free.desc g,
    let hh : free Z ⟶ X := free.desc h,
    have : gg ≫ f = hh ≫ f,
    { ext, dsimp [gg,hh, free.desc], simpa },
    rw cancel_mono at this,
    apply_fun (λ e, sigma.ι ((λ i : ulift.{v} ℕ, Z)) (ulift.up 0) ≫ e.f) at this,
    dsimp [gg, hh, free.desc] at this, simpa using this
  end }

instance free.projective (X : C) [projective X] : projective (free X) :=
{ factors := λ E Y f e he, begin
    resetI,
    let φ : X ⟶ Y.X := sigma.ι (λ i : ulift.{v} ℕ, X) ⟨0⟩ ≫ f.f,
    haveI : epi e.f := f_epi _,
    use free.desc (projective.factor_thru φ e.f),
    rw [free.desc_comp, projective.factor_thru_comp],
    ext1, dsimp, simp only [colimit.ι_desc, cofan.mk_ι_app, pow_zero, End.one_def, category.comp_id],
  end }

def free.presentation [enough_projectives C] (A : endomorphisms C) :
  projective_presentation A :=
{ P := free (projective.over A.X),
  projective := infer_instance,
  f := free.desc $ projective.π _,
  epi := begin
    suffices : epi (free.desc (projective.π A.X)).f,
    { resetI, apply epi_of_epi_f },
    dsimp,
    refine @epi_of_epi _ _ _ _ _ (sigma.ι _ _) _ (id _), { exact ⟨0⟩ },
    simp only [colimit.ι_desc, cofan.mk_ι_app, pow_zero, End.one_def, category.comp_id],
    apply_instance
  end }

instance [enough_projectives C] : enough_projectives (endomorphisms C) :=
{ presentation := λ A, ⟨free.presentation A⟩ }

-- generalize to colimits
instance projective_sigma {C ι : Type*} [category C] (P : ι → C) [has_coproduct P]
  [∀ i, projective (P i)] :
  projective (∐ P) :=
{ factors := begin
  introsI E X f e he,
  let φ : ∐ P ⟶ E := sigma.desc (λ i, projective.factor_thru (sigma.ι _ _ ≫ f) e),
  refine ⟨φ, _⟩,
  ext i,
  rw [limits.colimit.ι_desc_assoc, limits.cofan.mk_ι_app, projective.factor_thru_comp],
end }

instance projective_X [enough_projectives C] (P : endomorphisms C) [projective P] :
  projective P.X :=
⟨λ E X f e he, begin
  let F := free.presentation P,
  haveI : projective F.P.X := endomorphisms.projective_sigma _,
  haveI : epi F.f := F.epi,
  let s : P ⟶ F.P := projective.factor_thru (𝟙 _) F.f,
  have hsπ : s ≫ F.f = 𝟙 _ := projective.factor_thru_comp _ _,
  let X' : endomorphisms C := ⟨X, 𝟙 _⟩,
  let E' : endomorphisms C := ⟨E, 𝟙 _⟩,
  let e' : E' ⟶ X' := ⟨e, by { dsimp only, rw [category.id_comp, category.comp_id] }⟩,
  haveI he' : epi e' := epi_of_epi_f e',
  let φ : F.P.X ⟶ E := projective.factor_thru (F.f.f ≫ f) e,
  refine ⟨s.f ≫ φ, _⟩,
  rw [category.assoc, projective.factor_thru_comp, ← comp_f_assoc, hsπ, id_f, category.id_comp],
end⟩

end projectives

section preadditive
open category_theory.preadditive

variables {𝓐 : Type u} [category.{v} 𝓐] [preadditive 𝓐]
variables (X Y : endomorphisms 𝓐)

instance : has_zero (X ⟶ Y) := ⟨⟨0, by simp only [comp_zero, zero_comp, hom.comm]⟩⟩
instance : has_add (X ⟶ Y) := ⟨λ f g, ⟨f.f + g.f, by simp only [comp_add, add_comp, hom.comm]⟩⟩
instance : has_sub (X ⟶ Y) := ⟨λ f g, ⟨f.f - g.f, by simp only [comp_sub, sub_comp, hom.comm]⟩⟩
instance : has_neg (X ⟶ Y) := ⟨λ f, ⟨-f.f, by simp only [comp_neg, neg_comp, hom.comm]⟩⟩
instance has_nsmul : has_scalar ℕ (X ⟶ Y) := ⟨λ n f, ⟨n • f.f, by simp only [comp_nsmul, nsmul_comp, hom.comm]⟩⟩
instance has_zsmul : has_scalar ℤ (X ⟶ Y) := ⟨λ n f, ⟨n • f.f, by simp only [comp_zsmul, zsmul_comp, hom.comm]⟩⟩

instance : add_comm_group (X ⟶ Y) :=
(f_injective X Y).add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

@[simp] lemma zero_f : hom.f (0 : X ⟶ Y) = 0 := rfl
variables {X Y} (f g : X ⟶ Y)
@[simp] lemma add_f : (f + g).f = f.f + g.f := rfl
@[simp] lemma sub_f : (f - g).f = f.f - g.f := rfl
@[simp] lemma neg_f : (-f).f = -(f.f) := rfl
@[simp] lemma nsmul_f (n : ℕ) (f : X ⟶ Y) : (n • f).f = n • f.f := rfl
@[simp] lemma zsmul_f (n : ℤ) (f : X ⟶ Y) : (n • f).f = n • f.f := rfl

variables (𝓐)

instance : preadditive (endomorphisms 𝓐) :=
{ add_comp' := by { intros, ext, dsimp, rw add_comp },
  comp_add' := by { intros, ext, dsimp, rw comp_add } }

instance forget_additive : (endomorphisms.forget 𝓐).additive := {}

instance functor.free_additive [has_coproducts_of_shape (ulift.{v} ℕ) 𝓐] :
  (functor.free 𝓐).additive := ⟨λ X Y f g, by { delta functor.free free.map,
    ext, simp, }⟩

lemma is_zero_X {X : endomorphisms 𝓐} (h : is_zero X) : is_zero X.X :=
by { rw is_zero_iff_id_eq_zero at h ⊢, apply_fun (λ a, a.f) at h, exact h }

end preadditive

section abelian

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐]
  {X Y : endomorphisms 𝓐} (f : X ⟶ Y)

@[simps]
protected def kernel_obj : endomorphisms 𝓐 :=
{ X := kernel f.f,
  e := kernel.lift _ (kernel.ι _ ≫ X.e) (by simp) }

@[simps]
protected def kernel_ι : endomorphisms.kernel_obj f ⟶ X :=
{ f := kernel.ι _,
  comm := by { dsimp, simp } }

protected def kernel_fork : kernel_fork f :=
kernel_fork.of_ι (endomorphisms.kernel_ι f) $ by { ext, dsimp, simp }

@[simp]
protected lemma kernel_fork_ι_f :
  (endomorphisms.kernel_fork f).ι.f = kernel.ι _ := rfl

@[simps]
protected def kernel_lift (s : kernel_fork f) :
  s.X ⟶ endomorphisms.kernel_obj f :=
{ f := kernel.lift _ s.ι.f $ by { rw [← comp_f, s.condition, zero_f], },
  comm := by { ext, dsimp, simp } }

@[simps]
protected def is_limit_kernel_fork : is_limit (endomorphisms.kernel_fork f) :=
is_limit_aux _
(λ s, endomorphisms.kernel_lift f s)
(λ s, by { ext, dsimp, simp })
(λ s m hm, by { apply_fun (λ e, e.f) at hm, ext, dsimp at *, simp [hm] } )

instance has_kernels : has_kernels (endomorphisms 𝓐) :=
⟨λ X Y f, ⟨⟨⟨endomorphisms.kernel_fork _, endomorphisms.is_limit_kernel_fork _⟩⟩⟩⟩

@[simps]
protected def cokernel_obj : endomorphisms 𝓐 :=
{ X := cokernel f.f,
  e := cokernel.desc _ (Y.e ≫ cokernel.π _) $
    by { simp only [← (reassoc_of f.comm), cokernel.condition, comp_zero] } }

@[simps]
protected def cokernel_π : Y ⟶ endomorphisms.cokernel_obj f :=
{ f := cokernel.π _,
  comm := by simp }

protected def cokernel_cofork : cokernel_cofork f :=
cokernel_cofork.of_π (endomorphisms.cokernel_π f) $ by { ext, dsimp, simp }

@[simp]
protected lemma cokernel_cofork_π_f :
  (endomorphisms.cokernel_cofork f).π.f = cokernel.π _ := rfl

@[simps]
protected def cokernel_desc (s : cokernel_cofork f) :
  endomorphisms.cokernel_obj f ⟶ s.X :=
{ f := cokernel.desc _ s.π.f $ by { rw [← comp_f, s.condition, zero_f] },
  comm := by { ext, dsimp, simp } }

@[simps]
protected def is_colimit_cokernel_cofork : is_colimit (endomorphisms.cokernel_cofork f) :=
is_colimit_aux _
(λ s, endomorphisms.cokernel_desc f s)
(λ s, by { ext, dsimp, simp })
(λ s m hm, by { apply_fun (λ e, e.f) at hm, ext, dsimp at *, simp [hm] })

instance has_cokernels : has_cokernels (endomorphisms 𝓐) :=
⟨λ X Y f, ⟨⟨⟨endomorphisms.cokernel_cofork _, endomorphisms.is_colimit_cokernel_cofork _⟩⟩⟩⟩

def kernel_fork_iso :
  endomorphisms.kernel_fork f ≅ kernel_fork.of_ι (endomorphisms.kernel_ι f)
  (endomorphisms.kernel_fork f).condition :=
cones.ext
(iso.refl _)
(by { rintro (_|_); tidy })

def is_limit_fork_of_is_limit
  (hF : is_limit (limits.kernel_fork.of_ι f.f (cokernel.condition _))) :
  is_limit (limits.kernel_fork.of_ι f (endomorphisms.cokernel_cofork _).condition) :=
is_limit_aux _
(λ S,
{ f := hF.lift (kernel_fork.of_ι S.ι.f begin
    change _ ≫ (endomorphisms.cokernel_cofork _).π.f = _,
    erw [← comp_f, S.condition, zero_f],
  end),
  comm := begin
    apply hF.hom_ext, rintro (_|_),
    { dsimp, simp only [category.assoc, hom.comm], erw hF.fac _ (walking_parallel_pair.zero),
      erw hF.fac_assoc _ (walking_parallel_pair.zero),
      dsimp, simp, },
    { dsimp, simp, }
  end })
begin
  intros S,
  ext, dsimp, erw hF.fac _ walking_parallel_pair.zero, refl,
end
begin
  intros S m hm,
  ext, dsimp, apply hF.hom_ext, rintros (_|_),
  { apply_fun (λ e, e.f) at hm,
    dsimp at *,
    simp only [hm],
    erw hF.fac _ (walking_parallel_pair.zero), refl },
  { dsimp, simp },
end

def is_colimit_cofork_of_is_colimit
  (hF : is_colimit (limits.cokernel_cofork.of_π f.f (kernel.condition _))) :
  is_colimit (limits.cokernel_cofork.of_π f (endomorphisms.kernel_fork _).condition) :=
is_colimit_aux _
(λ S,
{ f := hF.desc (cokernel_cofork.of_π S.π.f begin
    change (endomorphisms.kernel_fork _).ι.f ≫ _ = _,
    erw [← comp_f, S.condition, zero_f]
  end),
  comm := begin
    apply hF.hom_ext, rintro (_|_),
    { dsimp, simp },
    { dsimp, erw hF.fac_assoc _ (walking_parallel_pair.one),
      rw [← hom.comm_assoc],
      erw hF.fac _ (walking_parallel_pair.one),
      dsimp, simp }
  end })
begin
  intros S,
  ext, dsimp, erw hF.fac _ walking_parallel_pair.one, refl,
end
begin
  intros S m hm,
  ext, dsimp, apply hF.hom_ext, rintros (_|_),
  { dsimp, simp },
  { apply_fun (λ e, e.f) at hm,
    dsimp at *,
    simp only [hm],
    erw hF.fac _ walking_parallel_pair.one, refl }
end

instance [has_coproducts_of_shape (ulift.{v} ℕ) 𝓐] [has_products_of_shape (ulift.{v} ℕ) 𝓐] :
  abelian (endomorphisms 𝓐) :=
{ normal_mono_of_mono := begin
    introsI X Y f _,
    haveI := f_mono f,
    let hE : is_limit (kernel_fork.of_ι f.f _) :=
      category_theory.abelian.mono_is_kernel_of_cokernel _ (colimit.is_colimit _),
    fconstructor,
    exact endomorphisms.cokernel_obj f,
    exact endomorphisms.cokernel_π f,
    exact (endomorphisms.cokernel_cofork f).condition,
    apply is_limit_fork_of_is_limit _ hE,
  end,
  normal_epi_of_epi := begin
    introsI X Y f _,
    haveI := f_epi f,
    let hE : is_colimit (cokernel_cofork.of_π f.f _) :=
      category_theory.abelian.epi_is_cokernel_of_kernel _ (limit.is_limit _),
    fconstructor,
    exact endomorphisms.kernel_obj f,
    exact endomorphisms.kernel_ι f,
    exact (endomorphisms.kernel_fork f).condition,
    apply is_colimit_cofork_of_is_colimit _ hE,
  end,
  has_finite_products := begin
    constructor, intros J _ _,
    haveI : has_finite_products 𝓐 := abelian.has_finite_products, -- WHY IS THIS NEEDED!?
    apply_instance,
  end,
  .. (_ : preadditive (endomorphisms 𝓐)) }

end abelian

end endomorphisms

end category_theory


import Mathlib.Data.List.Basic

@[simp] theorem List.toArrayAux_data : ∀ (l : List α) a, (l.toArrayAux a).data = a.data ++ l
| [], r => (append_nil _).symm
| a::as, r => (toArrayAux_data as (r.push a)).trans $
  by simp [Array.push, append_assoc, List.concat_eq_append]

@[simp] theorem List.toArray_data (l : List α) : l.toArray.data = l := toArrayAux_data _ _

namespace Array

theorem ext' : {a b : Array α} → a.data = b.data → a = b
| ⟨a⟩, ⟨_⟩, rfl => rfl

@[simp] theorem data_toArray : (a : Array α) → a.data.toArray = a
| ⟨l⟩ => ext' l.toArray_data

-- Port note: The Lean 4 core library has `toArrayLit_eq` with the same signature as this,
-- but currently its proof is `sorry`.
theorem toArrayLit_eq' (a : Array α) (n : Nat) (hsz : a.size = n) : a = toArrayLit a n hsz := by
  have := aux n
  rw [List.drop_eq_nil_of_le (Nat.le_of_eq hsz)] at this
  exact (data_toArray a).symm.trans $ congrArg List.toArray (this _).symm
where
  aux : ∀ i hi, toListLitAux a n hsz i hi (a.data.drop i) = a.data
  | 0, _ => rfl
  | i+1, hi => by
    simp [toListLitAux]
    suffices _::_ = _ by rw [this]; apply aux
    apply List.get_cons_drop

theorem get_eq_get (a : Array α) (i : Fin _) :
  a.get i = a.data.get i := rfl

theorem get?_eq_get (a : Array α) (i : Nat) (h : i < a.size) :
  a.get? i = some (a.get ⟨i, h⟩) := by simp [get?, h]

theorem get?_len_le (a : Array α) (i : Nat) (h : a.size ≤ i) :
  a.get? i = none := by simp [get?, not_lt_of_ge h]

theorem get?_eq_get? (a : Array α) (i : Nat) :
  a.get? i = a.data.get? i := by
  simp [get?]; split <;> rename_i h
  · simp [get, List.get?_eq_get h]
  · simp [List.get?_len_le (le_of_not_lt h)]

theorem get?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
  (a.push x).get? i = some (a.get ⟨i, h⟩) := by
  simp [push, get?_eq_get?, ← List.get?_eq_get, get_eq_get, List.concat_eq_append]
  exact List.get?_append h

theorem get?_push_eq (a : Array α) (x : α) :
  (a.push x).get? a.size = some x := by
  simp [push, get?_eq_get?, ← List.get?_eq_get, get_eq_get, List.concat_eq_append]

theorem get_push (a : Array α) (x : α) (i) :
  (a.push x).get i = if h : i < a.size then a.get ⟨i, h⟩ else x := by
  split <;> (rename_i h; apply Option.some.inj; rw [← get?_eq_get])
  · apply get?_push_lt
  · match i with | ⟨i, hi⟩ => ?_
    simp at hi ⊢
    rw [le_antisymm (Nat.le_of_lt_succ hi) (le_of_not_lt h), get?_push_eq]

@[simp] lemma get?_set_eq (a : Array α) (i) (v : α) : (a.set i v).get? i = v := by
  simp [set, get?_eq_get?, List.get?_set_of_lt _ i.2]

@[simp] lemma get?_set_ne (a : Array α) {i j} (v : α)
  (h : i.1 ≠ j) : (a.set i v).get? j = a.get? j := by
  simp [set, get?_eq_get?, List.get?_set_ne _ _ h]

lemma get?_set (a : Array α) (i j) (v : α) :
  (a.set i v).get? j = if i.1 = j then some v else a.get? j := by
  split; {subst j; simp}; simp_all

end Array


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import tactic.lint
import tactic.ext

section sigma
variables {α α₁ α₂ : Type*} {β : α → Type*} {β₁ : α₁ → Type*} {β₂ : α₂ → Type*}

namespace sigma

instance [inhabited α] [inhabited (β (default α))] : inhabited (sigma β) :=
⟨⟨default α, default (β (default α))⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (sigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n e₁))
  end

@[simp, nolint simp_nf] -- sometimes the built-in injectivity support does not work
theorem mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  sigma.mk a₁ b₁ = ⟨a₂, b₂⟩ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
by simp

@[simp] theorem eta : ∀ x : Σ a, β a, sigma.mk x.1 x.2 = x
| ⟨i, x⟩ := rfl

@[ext]
lemma ext {x₀ x₁ : sigma β} (h₀ : x₀.1 = x₁.1) (h₁ : x₀.2 == x₁.2) : x₀ = x₁ :=
by { cases x₀, cases x₁, cases h₀, cases h₁, refl }

lemma ext_iff {x₀ x₁ : sigma β} : x₀ = x₁ ↔ x₀.1 = x₁.1 ∧ x₀.2 == x₁.2 :=
by { cases x₀, cases x₁, exact sigma.mk.inj_iff }

/-- A specialized ext lemma for equality of sigma types over an indexed subtype. -/
@[ext]
lemma subtype_ext {β : Type*} {p : α → β → Prop} :
  ∀ {x₀ x₁ : Σ a, subtype (p a)}, x₀.fst = x₁.fst → (x₀.snd : β) = x₁.snd → x₀ = x₁
| ⟨a₀, b₀, hb₀⟩ ⟨a₁, b₁, hb₁⟩ rfl rfl := rfl

lemma subtype_ext_iff {β : Type*} {p : α → β → Prop} {x₀ x₁ : Σ a, subtype (p a)} :
  x₀ = x₁ ↔ x₀.fst = x₁.fst ∧ (x₀.snd : β) = x₁.snd :=
⟨λ h, h ▸ ⟨rfl, rfl⟩, λ ⟨h₁, h₂⟩, subtype_ext h₁ h₂⟩

@[simp] theorem «forall» {p : (Σ a, β a) → Prop} :
  (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : (Σ a, β a) → Prop} :
  (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

/-- Map the left and right components of a sigma -/
def map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) (x : sigma β₁) : sigma β₂ :=
⟨f₁ x.1, f₂ x.1 x.2⟩

end sigma

lemma sigma_mk_injective {i : α} : function.injective (@sigma.mk α β i)
| _ _ rfl := rfl

lemma function.injective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
  (h₁ : function.injective f₁) (h₂ : ∀ a, function.injective (f₂ a)) :
  function.injective (sigma.map f₁ f₂)
| ⟨i, x⟩ ⟨j, y⟩ h :=
begin
  have : i = j, from h₁ (sigma.mk.inj_iff.mp h).1,
  subst j,
  have : x = y, from h₂ i (eq_of_heq (sigma.mk.inj_iff.mp h).2),
  subst y
end

lemma function.surjective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
  (h₁ : function.surjective f₁) (h₂ : ∀ a, function.surjective (f₂ a)) :
  function.surjective (sigma.map f₁ f₂) :=
begin
  intros y,
  cases y with j y,
  cases h₁ j with i hi,
  subst j,
  cases h₂ i y with x hx,
  subst y,
  exact ⟨⟨i, x⟩, rfl⟩
end

/-- Interpret a function on `Σ x : α, β x` as a dependent function with two arguments. -/
def sigma.curry {γ : Π a, β a → Type*} (f : Π x : sigma β, γ x.1 x.2) (x : α) (y : β x) : γ x y :=
f ⟨x,y⟩

/-- Interpret a dependent function with two arguments as a function on `Σ x : α, β x` -/
def sigma.uncurry {γ : Π a, β a → Type*} (f : Π x (y : β x), γ x y) (x : sigma β) : γ x.1 x.2 :=
f x.1 x.2

/-- Convert a product type to a Σ-type. -/
@[simp]
def prod.to_sigma {α β} : α × β → Σ _ : α, β
| ⟨x,y⟩ := ⟨x,y⟩

@[simp]
lemma prod.fst_to_sigma {α β} (x : α × β) : (prod.to_sigma x).fst = x.fst :=
by cases x; refl

@[simp]
lemma prod.snd_to_sigma {α β} (x : α × β) : (prod.to_sigma x).snd = x.snd :=
by cases x; refl

end sigma

section psigma
variables {α : Sort*} {β : α → Sort*}

namespace psigma

/-- Nondependent eliminator for `psigma`. -/
def elim {γ} (f : ∀ a, β a → γ) (a : psigma β) : γ :=
psigma.cases_on a f

@[simp] theorem elim_val {γ} (f : ∀ a, β a → γ) (a b) : psigma.elim f ⟨a, b⟩ = f a b := rfl

instance [inhabited α] [inhabited (β (default α))] : inhabited (psigma β) :=
⟨⟨default α, default (β (default α))⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (psigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n e₁))
  end

theorem mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  @psigma.mk α β a₁ b₁ = @psigma.mk α β a₂ b₂ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
iff.intro psigma.mk.inj $
  assume ⟨h₁, h₂⟩, match a₁, a₂, b₁, b₂, h₁, h₂ with _, _, _, _, eq.refl a, heq.refl b := rfl end

@[ext]
lemma ext {x₀ x₁ : psigma β} (h₀ : x₀.1 = x₁.1) (h₁ : x₀.2 == x₁.2) : x₀ = x₁ :=
by { cases x₀, cases x₁, cases h₀, cases h₁, refl }

lemma ext_iff {x₀ x₁ : psigma β} : x₀ = x₁ ↔ x₀.1 = x₁.1 ∧ x₀.2 == x₁.2 :=
by { cases x₀, cases x₁, exact psigma.mk.inj_iff }

/-- A specialized ext lemma for equality of psigma types over an indexed subtype. -/
@[ext]
lemma subtype_ext {β : Sort*} {p : α → β → Prop} :
  ∀ {x₀ x₁ : Σ' a, subtype (p a)}, x₀.fst = x₁.fst → (x₀.snd : β) = x₁.snd → x₀ = x₁
| ⟨a₀, b₀, hb₀⟩ ⟨a₁, b₁, hb₁⟩ rfl rfl := rfl

lemma subtype_ext_iff {β : Sort*} {p : α → β → Prop} {x₀ x₁ : Σ' a, subtype (p a)} :
  x₀ = x₁ ↔ x₀.fst = x₁.fst ∧ (x₀.snd : β) = x₁.snd :=
⟨λ h, h ▸ ⟨rfl, rfl⟩, λ ⟨h₁, h₂⟩, subtype_ext h₁ h₂⟩

variables {α₁ : Sort*} {α₂ : Sort*} {β₁ : α₁ → Sort*} {β₂ : α₂ → Sort*}

/-- Map the left and right components of a sigma -/
def map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) : psigma β₁ → psigma β₂
| ⟨a, b⟩ := ⟨f₁ a, f₂ a b⟩

end psigma

end psigma


opaque f (a b : Nat) : Nat
example : f 1 2 = f 2 1 := by
  generalize h : f 1 = g
  /- g : ℕ → ℕ
  h : f 1 = g
  ⊢ g 2 = f 2 1 -/
  trace_state
  sorry


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

Direct sum of modules over commutative rings, indexed by a discrete type.
-/
import algebra.direct_sum
import linear_algebra.dfinsupp

/-!
# Direct sum of modules over commutative rings, indexed by a discrete type.

This file provides constructors for finite direct sums of modules.
It provides a construction of the direct sum using the universal property and proves
its uniqueness.

## Implementation notes

All of this file assumes that
* `R` is a commutative ring,
* `ι` is a discrete type,
* `S` is a finite set in `ι`,
* `M` is a family of `R` modules indexed over `ι`.
-/

universes u v w u₁

variables (R : Type u) [semiring R]
variables (ι : Type v) [dec_ι : decidable_eq ι] (M : ι → Type w)
variables [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]
include R

namespace direct_sum
open_locale direct_sum

variables {R ι M}

instance : module R (⨁ i, M i) := dfinsupp.module
instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] :
  smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class
instance {S : Type*} [semiring S] [has_scalar R S] [Π i, module S (M i)]
  [Π i, is_scalar_tower R S (M i)] :
  is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower

lemma smul_apply (b : R) (v : ⨁ i, M i) (i : ι) :
  (b • v) i = b • (v i) := dfinsupp.smul_apply _ _ _

include dec_ι

variables R ι M
/-- Create the direct sum given a family `M` of `R` modules indexed over `ι`. -/
def lmk : Π s : finset ι, (Π i : (↑s : set ι), M i.val) →ₗ[R] (⨁ i, M i) :=
dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof : Π i : ι, M i →ₗ[R] (⨁ i, M i) :=
dfinsupp.lsingle
variables {ι M}

lemma single_eq_lof (i : ι) (b : M i) :
  dfinsupp.single i b = lof R ι M i b := rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (s : finset ι) (c : R) (x) : mk M s (c • x) = c • mk M s x :=
(lmk R ι M s).map_smul c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (i : ι) (c : R) (x) : of M i (c • x) = c • of M i x :=
(lof R ι M i).map_smul c x

variables {R}
lemma support_smul [Π (i : ι) (x : M i), decidable (x ≠ 0)]
  (c : R) (v : ⨁ i, M i) : (c • v).support ⊆ v.support := dfinsupp.support_smul _ _

variables {N : Type u₁} [add_comm_monoid N] [module R N]
variables (φ : Π i, M i →ₗ[R] N)

variables (R ι N φ)
/-- The linear map constructed using the universal property of the coproduct. -/
def to_module : (⨁ i, M i) →ₗ[R] N :=
dfinsupp.lsum ℕ φ

variables {ι N φ}

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] lemma to_module_lof (i) (x : M i) : to_module R ι N φ (lof R ι M i x) = φ i x :=
to_add_monoid_of (λ i, (φ i).to_add_monoid_hom) i x

variables (ψ : (⨁ i, M i) →ₗ[R] N)

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (f : ⨁ i, M i) : ψ f = to_module R ι N (λ i, ψ.comp $ lof R ι M i) f :=
to_add_monoid.unique ψ.to_add_monoid_hom f

variables {ψ} {ψ' : (⨁ i, M i) →ₗ[R] N}

theorem to_module.ext (H : ∀ i, ψ.comp (lof R ι M i) = ψ'.comp (lof R ι M i)) (f : ⨁ i, M i) :
  ψ f = ψ' f :=
by rw dfinsupp.lhom_ext' H

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), M i) →ₗ (⨁ (i : T), M i) :=
to_module R _ _ $ λ i, lof R T (λ (i : subtype T), M i) ⟨i, H i.prop⟩

omit dec_ι

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [module R M]
  [unique ι] :
  (⨁ (_ : ι), M) ≃ₗ M :=
{ .. direct_sum.id M ι,
  .. to_module R ι M (λ i, linear_map.id) }

variables (ι M)
/-- The projection map onto one component, as a linear map. -/
def component (i : ι) : (⨁ i, M i) →ₗ[R] M i :=
dfinsupp.lapply i

variables {ι M}

lemma apply_eq_component (f : ⨁ i, M i) (i : ι) :
  f i = component R ι M i f := rfl

@[ext] lemma ext {f g : ⨁ i, M i}
  (h : ∀ i, component R ι M i f = component R ι M i g) : f = g :=
dfinsupp.ext h

lemma ext_iff {f g : ⨁ i, M i} : f = g ↔
  ∀ i, component R ι M i f = component R ι M i g :=
⟨λ h _, by rw h, ext R⟩

include dec_ι

@[simp] lemma lof_apply (i : ι) (b : M i) : ((lof R ι M i) b) i = b :=
dfinsupp.single_eq_same

@[simp] lemma component.lof_self (i : ι) (b : M i) :
  component R ι M i ((lof R ι M i) b) = b :=
lof_apply R i b

lemma component.of (i j : ι) (b : M j) :
  component R ι M i ((lof R ι M j) b) =
  if h : j = i then eq.rec_on h b else 0 :=
dfinsupp.single_apply

/-- The `direct_sum` formed by a collection of `submodule`s of `M` is said to be internal if the
canonical map `(⨁ i, A i) →ₗ[R] M` is bijective. -/
def submodule_is_internal {R M : Type*}
  [semiring R] [add_comm_monoid M] [module R M]
  (A : ι → submodule R M) : Prop :=
function.bijective (to_module R ι M (λ i, (A i).subtype))

lemma submodule_is_internal.to_add_submonoid {R M : Type*}
  [semiring R] [add_comm_monoid M] [module R M] (A : ι → submodule R M) :
  submodule_is_internal A ↔ add_submonoid_is_internal (λ i, (A i).to_add_submonoid) :=
iff.rfl

lemma submodule_is_internal.to_add_subgroup {R M : Type*}
  [ring R] [add_comm_group M] [module R M] (A : ι → submodule R M) :
  submodule_is_internal A ↔ add_subgroup_is_internal (λ i, (A i).to_add_subgroup) :=
iff.rfl

end direct_sum