import M4R.Algebra.Group.MapGroups
import M4R.Algebra.Group.Sum

namespace M4R

  structure Finsupp (α : Type _) (β : Type _) [Zero β] :=
  (support            : Finset α)
  (to_fun             : α → β)
  (mem_support_to_fun : ∀a, a ∈ support ↔ to_fun a ≠ 0)

  infixr:25 " →₀ " => Finsupp

  namespace Finsupp

    instance FinsuppFun [Zero β] : CoeFun (α →₀ β) (fun (x : α →₀ β) => α → β) where coe := to_fun

    @[simp] theorem mem_support_iff [Zero β] {f : α →₀ β} {a : α} : a ∈ f.support ↔ f a ≠ 0 :=
      f.mem_support_to_fun a

    theorem not_mem_support_iff [Zero β] {f : α →₀ β} {a : α} : a ∉ f.support ↔ f a = 0 := by
      apply not_iff_not.mp
      simp only [iff_not_not]
      exact mem_support_iff

    protected theorem ext [Zero β] {x y : α →₀ β} : x.to_fun = y.to_fun → x = y :=
      match x, y with | ⟨xs, _, xc⟩, ⟨ys, _, yc⟩ => fun hf => by
        simp at hf
        rw [Finsupp.mk.injEq]
        exact ⟨Finset.ext fun _ => by rw [xc, yc, hf]; exact Iff.rfl, hf⟩

    protected theorem ext' [Zero β] {x y : α →₀ β} : x = y ↔ x.support = y.support ∧ ∀ a ∈ x.support, x a = y a :=
      ⟨fun h => by rw [h]; exact ⟨rfl, fun _ _ => rfl⟩, fun h => by
        apply Finsupp.ext; apply funext; intro a
        byCases hx : a ∈ x.support
        exact h.right a hx
        have hy : a ∉ y.support := by rw [h.left] at hx; exact hx
        rw [of_not_not (mt mem_support_iff.mpr hx),
          of_not_not (mt mem_support_iff.mpr hy)]⟩

    protected theorem ext_iff [Zero β] (x y : α →₀ β) : x = y ↔ x.to_fun = y.to_fun :=
      ⟨fun h => by rw [h], Finsupp.ext⟩

    protected instance zero (α : Type _) (β : Type _) [Zero β] : Zero (α →₀ β) where zero :=
    {
      support            := ∅
      to_fun             := fun _ => 0
      mem_support_to_fun := fun _ => ⟨fun h _ => h, fun h => h rfl⟩
    }

    theorem zero_apply [Zero β] {a : α} : (0 : α →₀ β) a = 0 := rfl
    theorem zero_support [Zero β] : (0 : α →₀ β).support = ∅ := rfl

    theorem empty_support [Zero β] {f : α →₀ β} (h : f.support = ∅) : f = 0 :=
      Finsupp.ext (funext fun x => by
        have : x ∉ f.support := fun h' => by rw [h] at h'; contradiction
        rw [of_not_not (mt mem_support_iff.mpr this)]; rfl)

    theorem zero_fun [Zero β] {f : α →₀ β} (h : ∀ a, f a = 0) : f = 0 :=
      Finsupp.ext (funext fun x => by rw [h x]; rfl)

    def support_set_of_fun [Zero β] (f : α → β) : Set α := {a | f a ≠ 0}

    theorem support_of_fun_finite [Zero β] (x y : α →₀ β) (f : α → β) (h : ∀ a, x a = 0 → y a = 0 → f a = 0) :
      finite (support_set_of_fun f) :=
        finite.subset (finite.union x.support.to_finite y.support.to_finite) fun a af =>
          Classical.byContradiction fun h' =>
            have h' := not_or_iff_and_not.mp h'
            af (h a
              (of_not_not (mt mem_support_iff.mpr h'.left))
              (of_not_not (mt mem_support_iff.mpr h'.right)))

    noncomputable def support_of_fun [Zero β] (x y : α →₀ β) (f : α → β) (h : ∀ a, x a = 0 → y a = 0 → f a = 0) : Finset α :=
      (support_of_fun_finite x y f h).to_finset

    theorem support_of_fun_complete [Zero β] (x y : α →₀ β) (f : α → β) (h : ∀ a, x a = 0 → y a = 0 → f a = 0) :
      ∀ a, a ∈ support_of_fun x y f h ↔ f a ≠ 0 := fun _ => by
        simp [support_of_fun]; exact Iff.rfl

    noncomputable def finsupp_fun [Zero β] (f : (α →₀ β) → (α →₀ β) → α → β)
      (h : ∀ (x y : α →₀ β) (a : α), x a = 0 → y a = 0 → f x y a = 0) (x y : α →₀ β) : α →₀ β where
      to_fun := f x y
      support := support_of_fun x y (f x y) (h x y)
      mem_support_to_fun := support_of_fun_complete x y (f x y) (h x y)

    protected noncomputable instance add [Monoid β] : Add (α →₀ β) where
      add := finsupp_fun (·.to_fun + ·.to_fun) (fun x y a hx hy => by
        simp only [HAdd.hAdd, Add.add, add_eq]; rw [hx, hy, Monoid.add_zero])

    noncomputable instance toMonoid [Monoid β] : Monoid (α →₀ β) where
      add_zero := fun _ => Finsupp.ext (funext fun _ => Monoid.add_zero _)
      zero_add := fun _ => Finsupp.ext (funext fun _ => Monoid.zero_add _)
      add_assoc := fun _ _ _ => Finsupp.ext (funext fun _ => Monoid.add_assoc _ _ _)

    noncomputable instance toCommMonoid [CommMonoid β] : CommMonoid (α →₀ β) where
      add_comm := fun _ _ => Finsupp.ext (funext fun _ => CommMonoid.add_comm _ _)

    protected instance neg [Group β] : Neg (α →₀ β) where
      neg := fun x => {
        support := x.support
        to_fun := (- x ·)
        mem_support_to_fun := fun a =>
          have : x a ≠ 0 ↔ - x a ≠ 0 := by
            simp only [not_iff_not]
            exact ⟨fun h' => by rw [h', Group.neg_zero], fun h' => by
              rw [←Group.neg_zero] at h'
              exact Group.neg_inj h'⟩
          mem_support_iff.trans this
      }

    noncomputable instance toGroup [Group β] : Group (α →₀ β) where
      add_neg := fun _ => Finsupp.ext (funext fun _ => Group.add_neg _)

    noncomputable instance toAbelianGroup [AbelianGroup β] : AbelianGroup (α →₀ β) where
      add_comm := toCommMonoid.add_comm

    theorem add_apply [Monoid β] (f₁ f₂ : α →₀ β) (a : α) : (f₁ + f₂) a = f₁ a + f₂ a := rfl

    theorem support_add [Monoid β] {f₁ f₂ : α →₀ β} :
      (f₁ + f₂).support ⊆ f₁.support ∪ f₂.support := by
        intro x hx
        apply Classical.byContradiction; intro h
        simp only [Finset.mem_union, not_or_iff_and_not] at h
        have : (f₁ + f₂) x = f₁ x + f₂ x := rfl
        rw [not_mem_support_iff.mp h.left, not_mem_support_iff.mp h.right, Monoid.add_zero] at this
        exact absurd this (mem_support_iff.mp hx)

    open Classical

    noncomputable def single [Zero β] (a : α) (b : β) : α →₀ β where
      support := if b = 0 then ∅ else Finset.singleton a
      to_fun := fun a' => if a' = a then b else 0
      mem_support_to_fun := fun a' => by
        byCases hb : b = 0
        exact ⟨fun h _ => by simp only [hb] at h; exact h,
          fun h => by
            simp only [hb] at h ⊢; apply h; byCases ha : a' = a
            repeat { simp only [ha]; rfl }⟩
        exact ⟨fun h => by
            simp only [hb] at h; have := Finset.in_singleton h
            simp only [this]; exact hb,
          fun h => by
            byCases ha : a' = a
            { simp only [hb, ha]; exact Finset.self_singleton a }
            { simp only [ha] at h; contradiction }⟩

    namespace single

      @[simp] protected theorem zero {α : Type _} (β : Type _) [Zero β] (a : α) : single a (0 : β) = 0 := by
        apply Finsupp.ext; apply funext; intro x; simp only [single]; byCases hx : x = a
        repeat { simp only [hx]; rfl }

      @[simp] theorem eq_same [Zero β] (a : α) (b : β): single a b a = b :=
        if_pos rfl

      @[simp] theorem eq_of_ne [Zero β] {a a' : α} (b : β) (h : a' ≠ a) : single a b a' = 0 :=
        if_neg h

      @[simp] protected theorem add [Monoid β] (a : α) (b₁ b₂ : β) :
        single a (b₁ + b₂) = single a b₁ + single a b₂ := by
        apply Finsupp.ext; apply funext; intro x
        byCases h : x = a
        { rw [h, add_apply, eq_same, eq_same, eq_same] }
        { rw [add_apply, eq_of_ne (b₁ + b₂) h, eq_of_ne b₁ h, eq_of_ne b₂ h, Monoid.zero_add] }

    end single

    noncomputable instance UnitFinsuppMonoid [Monoid α] : (Unit →₀ α) ≅₊ α where
      hom := (· Unit.unit)
      preserve_zero := rfl
      preserve_add := fun _ _ => rfl
      inv := fun a => single Unit.unit a
      left_inv := fun x => Finsupp.ext (funext fun u => by cases u; simp only [single.eq_same])
      right_inv := fun a => by simp only [single.eq_same]

    noncomputable instance UnitFinsuppGroup [Group α] : (Unit →₀ α) ≅₋ α where
      toMHomomorphism := UnitFinsuppMonoid.toMHomomorphism
      preserve_neg := fun _ => rfl
      inv := UnitFinsuppMonoid.inv
      left_inv := UnitFinsuppMonoid.left_inv
      right_inv := UnitFinsuppMonoid.right_inv

    theorem UnitFinsupp.single [Zero α] (x : Unit →₀ α) : x = single Unit.unit (x Unit.unit) :=
      Finsupp.ext (funext fun u => by cases u; simp only [single.eq_same])

    section erase

      noncomputable def erase [Zero β] (a : α) (f : α →₀ β) : α →₀ β where
        support := f.support.erase a
        to_fun := fun a' => if a' = a then 0 else f a'
        mem_support_to_fun := fun a' => by
          rw [Finset.mem_erase, mem_support_iff]
          byCases h : a' = a
          { simp only [h, ite_true, ne_eq, false_and] }
          { simp only [h, ite_false, ne_eq, true_and]; exact Iff.rfl }

      @[simp] theorem support_erase [Zero β] {a : α} {f : α →₀ β} :
        (f.erase a).support = f.support.erase a := rfl

      @[simp] theorem erase_same [Zero β] {a : α} {f : α →₀ β} : (f.erase a) a = 0 :=
        if_pos rfl

      @[simp] theorem erase_ne [Zero β] {a a' : α} {f : α →₀ β} (h : a' ≠ a) : (f.erase a) a' = f a' :=
        if_neg h

      @[simp] theorem erase_single [Zero β] {a : α} {b : β} : (erase a (single a b)) = 0 := by
        apply Finsupp.ext; apply funext; intro x
        byCases h : x = a
        { rw [h, erase_same, zero_apply] }
        { rw [erase_ne h]; exact single.eq_of_ne b h }

      theorem erase_single_ne [Zero β] {a a' : α} {b : β} (h : a ≠ a') : (erase a (single a' b)) = single a' b := by
        apply Finsupp.ext; apply funext; intro x
        byCases h' : x = a
        { rw [h', erase_same, single.eq_of_ne b h] }
        { rw [erase_ne h'] }

      @[simp] theorem erase_of_not_mem_support [Zero β] {f : α →₀ β} {a} (haf : a ∉ f.support) : erase a f = f := by
        apply Finsupp.ext; apply funext; intro x
        byCases h : x = a
        { rw [h, erase_same]; exact (not_mem_support_iff.mp haf).symm }
        { rw [erase_ne h] }

      @[simp] theorem erase_zero [Zero β] (a : α) : erase a (0 : α →₀ β) = 0 := by
        apply empty_support; rw [support_erase, zero_support, Finset.erase_empty]

    end erase

    section update
      variable [Zero β] (f : α →₀ β)

      noncomputable def update (a : α) (b : β) : α →₀ β where
        support := if b = 0 then f.support.erase a else f.support.insert a
        to_fun := Function.update f a b
        mem_support_to_fun := fun i => by
          simp only [Function.update_apply, ne_eq]
          byCases hb : b = 0
          { simp only [hb, ite_true]
            byCases hi : i = a;
            { simp only [hi, ite_true, Finset.mem_erase, ne_eq, false_and] }
            { simp only [hi, ite_false, Finset.mem_erase, ne_eq, true_and]; exact Finsupp.mem_support_iff } }
          { simp only [hb, ite_false]
            byCases hi : i = a;
            { simp only [hi, ite_true, Finset.mem_insert_self, true_iff]; exact hb }
            { simp only [hi, ite_false, Finset.mem_insert, false_or]; exact Finsupp.mem_support_iff } }

      @[simp] theorem coe_update (a : α) (b : β) :
        (f.update a b : α → β) = Function.update f a b := rfl

      @[simp] theorem update_self (a : α) : f.update a (f a) = f := by
        apply Finsupp.ext; apply funext; intro x
        simp only [update, Function.update_apply]
        byCases hx : x = a
        { simp only [hx, ite_true] }
        { simp only [hx, ite_false] }

      theorem support_update (a : α) (b : β) : support (f.update a b) =
        if b = 0 then f.support.erase a else f.support.insert a := rfl

      @[simp] theorem support_update_zero (a : α) :
        support (f.update a 0) = f.support.erase a := if_pos rfl

      theorem support_update_ne_zero (a : α) {b : β} (h : b ≠ 0) :
        support (f.update a b) = f.support.insert a := if_neg h

    end update
    section
      variable [Monoid β] (f : α →₀ β)

      theorem update_eq_single_add_erase (a : α) (b : β) :
        f.update a b = (single a b) + (f.erase a) := by
          apply Finsupp.ext; apply funext; intro j
          simp only [update, Function.update_apply, add_apply]
          byCases h : j = a
          { simp only [h, ite_true, single.eq_same, erase_same, Monoid.add_zero] }
          { simp only [h, ite_false, single.eq_of_ne b h, erase_ne h, Monoid.zero_add] }

      theorem update_eq_erase_add_single (f : α →₀ β) (a : α) (b : β) :
        f.update a b = f.erase a + single a b := by
          apply Finsupp.ext; apply funext; intro j
          simp only [update, Function.update_apply, add_apply]
          byCases h : j = a
          { simp only [h, ite_true, single.eq_same, erase_same, Monoid.zero_add] }
          { simp only [h, ite_false, single.eq_of_ne b h, erase_ne h, Monoid.add_zero] }

      theorem single_add_erase (a : α) (f : α →₀ β) : single a (f a) + f.erase a = f := by
        rw [←update_eq_single_add_erase, update_self]

      theorem erase_add_single (a : α) (f : α →₀ β) : f.erase a + single a (f a) = f := by
        rw [←update_eq_erase_add_single, update_self]

    end

    protected theorem induction [Monoid β] (p : (α →₀ β) → Prop) (f : α →₀ β)
      (h0 : p 0) (ha : ∀ a b (f : α →₀ β), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) :
      p f := by
        have : ∀ s (f : α →₀ β), f.support = s → p f := fun s =>
          Finset.induction_on (∀ (f : α →₀ β), f.support = · → p f) s
            (fun f hf => empty_support hf ▸ h0)
            (fun a s has ih f hf => by
              have := ha a (f a) (f.erase a)
                (by rw [support_erase, Finset.mem_erase]; exact (·.left rfl))
                (by rw [← mem_support_iff, hf]; exact Finset.mem_insert_self _ _)
                (by apply ih _ _; rw [support_erase, hf, Finset.erase_insert has])
              rw [single_add_erase] at this
              exact this)
        exact this _ _ rfl

    noncomputable def single_add_hom [Monoid β] (a : α) : β →₊ α →₀ β where
      hom := single a
      preserve_zero := single.zero β a
      preserve_add := single.add a

    theorem add_hom_ext [Monoid β] [Monoid γ] ⦃f g : (α →₀ β) →₊ γ⦄
      (h : ∀ x y, f (single x y) = g (single x y)) :
      f = g := by
        apply MHomomorphism.ext.mpr; apply funext; intro x
        exact Finsupp.induction (fun s => f s = g s) x
          (by simp only [f.preserve_zero, g.preserve_zero])
          (fun a b y hay hb hy => by simp only [f.preserve_add, g.preserve_add, hy, h a b])

    theorem add_hom_ext' [Monoid β] [Monoid γ] ⦃f g : (α →₀ β) →₊ γ⦄
      (h : ∀ x, (single_add_hom x).comp f = (single_add_hom x).comp g) :
        f = g := add_hom_ext fun x => MHomomorphism.congr_fun (h x)

    protected def map_sum [Zero β] [CommMonoid γ] (f : α →₀ β) (g : α → β → γ) : γ :=
      ∑ a in f.support, g a (f a)

    namespace map_sum

      theorem support_sum [Zero β] [CommMonoid γ] (x : α →₀ β) (f : α → β → γ) : (∑ f in x) = ∑ a in x.support, f a (x a) := rfl

      @[simp] protected theorem zero_sum [Zero β] [CommMonoid γ] (f : α → β → γ) : (∑ f in (0 : α →₀ β)) = 0 :=
        UnorderedList.map_sum.eq_zero fun _ _ => by contradiction

      @[simp] protected theorem sum_zero [Zero β] [CommMonoid γ] (x : α →₀ β) : (∑ fun _ _ => (0 : γ) in x) = 0 :=
        UnorderedList.map_sum.eq_zero fun _ _ => rfl

      @[simp] protected theorem map_eq_zero [Zero β] [CommMonoid γ] {x : α →₀ β} {f : α → β → γ}
        (h : ∀ a ∈ x.support, f a (x a) = 0) : (∑ f in x) = 0 :=
          UnorderedList.map_sum.eq_zero h

      @[simp] protected theorem congr [Zero β] [CommMonoid γ] {x : α →₀ β} {f g : α → β → γ}
        (h : ∀ a ∈ x.support, f a (x a) = g a (x a)) : (∑ f in x) = (∑ g in x) :=
          UnorderedList.map_sum.congr rfl h

      def apply_add_hom [CommMonoid β] (a : α) : (α →₀ β) →₊ β where
        hom           := fun g => g a
        preserve_zero := zero_apply
        preserve_add  := (add_apply · · a)

      theorem finset_sum_apply [CommMonoid β] (S : Finset ι) (f : ι → α →₀ β) (a : α) :
        (∑ f in S) a = ∑ (f · a) in S :=
          (apply_add_hom a).map_sum f S

      @[simp] theorem sum_apply [Zero β] [CommMonoid β'] {f : α →₀ β} {g : α → β → α' →₀ β'} {a₂ : α'} :
        (∑ g in f) a₂ = ∑ (fun a₁ b => g a₁ b a₂) in f :=
          finset_sum_apply _ _ _

      @[simp] protected theorem single [Zero β] [CommMonoid γ]
        (a : α) (b : β) (f : α → β → γ) (h : f a 0 = 0) : (∑ f in single a b) = f a b := by
          byCases hb : b = 0
          { simp [support_sum, single, hb, h] }
          { simp [support_sum, Finset.map_sum, single, hb, Finset.singleton] }

      theorem unit_sum [Zero α] [CommMonoid β] {f : Unit → α → β} (x : Unit →₀ α) (h : f Unit.unit 0 = 0):
        (∑ f in x) = f Unit.unit (x Unit.unit) := by
          rw [UnitFinsupp.single x, map_sum.single Unit.unit (x Unit.unit) f h, single.eq_same]

      theorem support_subset [Zero β] [CommMonoid γ] (f : α →₀ β) {s : Finset α}
        (hs : f.support ⊆ s) (g : α → β → γ) (h : ∀ i ∈ s, g i 0 = 0) :
          (∑ g in f) = ∑ x in s, g x (f x) :=
            Finset.map_sum.subset hs (fun x hxs hx => by
              rw [of_not_not (mt mem_support_iff.mpr hx)]
              exact h x hxs)

      theorem sum_add [Zero β] [CommMonoid γ] {f : α →₀ β} {h₁ h₂ : α → β → γ} :
        (∑ (fun a b => h₁ a b + h₂ a b) in f) = (∑ h₁ in f) + (∑ h₂ in f) :=
          Finset.map_sum.distrib (fun a => h₁ a (f a)) (fun a => h₂ a (f a)) f.support

      protected theorem add_sum [Monoid β] [CommMonoid γ] (x y : α →₀ β) (f : α → β → γ)
        (h₁ : ∀ a, f a 0 = 0) (h₂ : ∀ a, f a ((x + y) a) = f a (x a) + f a (y a)) :
          (∑ f in x + y) = (∑ f in x) + (∑ f in y) := by
            have hx : (∑ f in x) = ∑ a in x.support ∪ y.support, f a (x a) :=
              support_subset x (Finset.subset_union_left _ _) f (fun a ha => h₁ a)
            have hy : (∑ f in y) = ∑ a in x.support ∪ y.support, f a (y a) :=
              support_subset y (Finset.subset_union_right _ _) f (fun a ha => h₁ a)
            have hxy : (∑ f in x + y) = ∑ a in x.support ∪ y.support, f a ((x + y) a) :=
              support_subset (x + y) support_add f (fun a ha => h₁ a)
            have := Finset.map_sum.distrib (fun a => f a (x a)) (fun a => f a (y a)) (x.support ∪ y.support)
            rw [hx, hy, hxy, ←this]
            exact Finset.map_sum.congr rfl fun a _ => h₂ a

      theorem sum_finset_sum_index [CommMonoid β] [CommMonoid γ] {s : Finset ι} {g : ι → α →₀ β}
        {h : α → β → γ} (h_zero : ∀ a, h a 0 = 0) (h_add : ∀ a b₁ b₂, h a (b₁ + b₂) = h a b₁ + h a b₂) :
          (∑ (∑ h in g ·) in s) = ∑ h in (∑ g in s) :=
            Finset.induction_on (fun f => (∑ (∑ h in g ·) in f) = ∑ h in (∑ g in f)) s rfl
              (fun a s has ih => by
                simp only at ih ⊢
                rw [Finset.map_sum.sum_insert _ has, ih, Finset.map_sum.sum_insert _ has,
                  map_sum.add_sum (g a) (∑ g in s) h h_zero (h_add · _ _)])

      theorem sum_sum {β : Type _} {β' : Type _} {γ : Type _} [CommMonoid β] [CommMonoid β'] [CommMonoid γ]
        {f : α →₀ β} {g : α → β → α' →₀ β'} {h : α' → β' → γ}
        (h_zero : ∀ a, h a 0 = 0) (h_add : ∀ a b₁ b₂, h a (b₁ + b₂) = h a b₁ + h a b₂) :
          (∑ h in (∑ g in f)) = ∑ (fun a b => ∑ h in g a b) in f :=
            (sum_finset_sum_index h_zero h_add).symm

      noncomputable def lift_add_hom [CommMonoid β] [CommMonoid γ] : (α → β →₊ γ) ≅₊ ((α →₀ β) →₊ γ) where
        hom := fun f => {
          hom := fun x => ∑ a in x, f a
          preserve_zero := map_sum.zero_sum _
          preserve_add := fun x y =>
            map_sum.add_sum x y _ (by intro; rw [MHomomorphism.preserve_zero])
              (by intro; rw [add_apply, MHomomorphism.preserve_add])
        }
        preserve_zero := by
          apply MHomomorphism.ext.mpr; apply funext; exact map_sum.sum_zero
        preserve_add := fun x y => by
          apply MHomomorphism.ext.mpr; apply funext; intros; exact map_sum.sum_add
        inv := fun f x => (single_add_hom x).comp f
        left_inv := by
          intro x; apply funext; intro a; apply MHomomorphism.ext.mpr; apply funext; intro b
          exact map_sum.single a b _ (x a).preserve_zero
        right_inv := fun x => add_hom_ext
          (fun a b => by
            simp only [single_add_hom]
            rw [map_sum.single a b _ (MHomomorphism.preserve_zero _), MHomomorphism.comp.hom])

      @[simp] theorem lift_add_hom_single_add_hom [CommMonoid β] :
        lift_add_hom (single_add_hom : α → β →₊ α →₀ β) = MHomomorphism.Identity := by
          apply MHomomorphism.ext.mpr; apply funext; intros; apply Finsupp.ext; apply funext; intros
          rw [←lift_add_hom.right_inv (MHomomorphism.Identity : (α →₀ β) →₊ α →₀ β)]; rfl

      @[simp] theorem sum_single [CommMonoid β] (f : α →₀ β) : (∑ single in f) = f :=
        MHomomorphism.congr_fun lift_add_hom_single_add_hom f

    end map_sum
  end Finsupp
end M4R


namespace integer_numbers

set_option trace.simplify.rewrite true

inductive myint
| zero : myint
| succ : myint → myint
| pred : myint → myint

def P := myint.pred
def S := myint.succ

axiom succ_pred {n : myint} : S (P n) = n
axiom pred_succ {n : myint} : P (S n) = n

attribute [simp] succ_pred pred_succ

lemma sspp (n : myint) : S (S (P (P n))) = n :=
begin
  -- S (S (P (P n))) = n
  -- P (S (S (P (P n)))) = P n
  -- use pred_succ
  -- S (P (P n)) = P n
  -- use pred_succ
  -- P (P n) = P (P n)
  -- rw succ_pred,

  -- try to substitute S (P n) → n
  -- apply eq.subst (succ_pred.symm),
  rw succ_pred,
  exact succ_pred,
end

#print sspp

-- λ (n : myint), (id ((eq.refl (S (S (P (P n))) = n)).rec succ_pred)).mpr succ_pred

lemma sspp₂ (n : myint) : S (S (P (P n))) = n :=
begin
  apply (eq.mpr _ succ_pred),
  exact n,
  have h := (eq.rec succ_pred),
  type_check (h succ_pred), -- S (P (S (P ?m_1))) = ?m_1
  sorry,
end

lemma ppss (n : myint) : P (P (S (S n))) = n :=
  by rw [pred_succ, pred_succ]

lemma comm_succ_pred (n : myint) : S (P n) = P (S n) :=
  by rw [succ_pred, pred_succ]

#print comm_succ_pred

example : S (P myint.zero) = myint.zero := succ_pred

def pos : nat → myint
| 0            := myint.zero
| (nat.succ n) := myint.succ (pos n)

def neg : nat → myint
| 0            := myint.zero
| (nat.succ n) := myint.pred (neg n)

lemma pos_zero : pos 0 = myint.zero := rfl
lemma pos_one : pos 1 = S myint.zero := rfl
lemma neg_one : neg 1 = P myint.zero := rfl

example : (neg 1).succ.succ = pos 1 :=
begin
  rw neg_one,
  rw pos_one,
  sorry,
end

example : S (S (neg 1)) = pos 1 :=
begin
  rw neg_one,
  rw succ_pred,
  exact pos_one,
end

def add : myint → myint → myint
| myint.zero n     := n
| (myint.succ m) n := myint.succ (add m n)
| (myint.pred m) n := myint.pred (add m n)

instance : has_zero myint := ⟨myint.zero⟩
instance : has_one myint := ⟨myint.succ myint.zero⟩
instance : has_add myint := ⟨add⟩

def myint.one := myint.succ 0
def myint.neg_one := myint.succ 0
-- attribute [pattern] myint.one

example : 0 + 0 = myint.zero := rfl
example : 0 + 1 = myint.one := rfl

lemma myint.one_def : 1 = myint.one := rfl
attribute [simp] myint.one_def

example : neg 1 + 1 = 0 :=
begin
  -- simp only [(+)],
  -- rw [neg, neg, add, add],
  -- rw myint.one_def,
  -- rw myint.one,
  exact pred_succ,
end

lemma zero_add (n : myint) : add 0 n = n := rfl
lemma add_zero (n : myint) : add n 0 = n :=
begin
  induction n with n ih n ih,
  { refl },
  sorry,
end

lemma add_zero_one : add 0 1 = 1 ∧ add 1 0 = 1 := by split; refl
lemma some (a b : Prop) {ha : a} {hb : b} : a ∧ b := by split; assumption
example : and.intro add_zero_one.left add_zero_one.right = add_zero_one := rfl
example : add_zero_one.left = add_zero_one.1 ∧ add_zero_one.right = add_zero_one.2 :=
  ⟨rfl, rfl⟩

end integer_numbers

namespace halfnumbers

inductive nat
| zero : nat
| succ : nat → nat
| halfpred : nat → nat

notation 0 := nat.zero
def S := nat.succ
def P := nat.halfpred
notation 1 := S 0
axiom succ_pred_2 : ∀ n : nat, S (P (P n)) = n
axiom pred_2_succ : ∀ n : nat, P (P (S n)) = n
-- We dont need this type of numbers because:
--   If substitute [P (P n) → P² n] in all theorems than halfnumbers becomes
-- integer numbers with successor S and predecessor P².

-- But if P has additional properties rather than P²?

end halfnumbers


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.solvable
import linear_algebra.eigenspace
import ring_theory.nilpotent

/-!
# Nilpotent Lie algebras

Like groups, Lie algebras admit a natural concept of nilpotency. More generally, any Lie module
carries a natural concept of nilpotency. We define these here via the lower central series.

## Main definitions

  * `lie_module.lower_central_series`
  * `lie_module.is_nilpotent`

## Tags

lie algebra, lower central series, nilpotent
-/

universes u v w w₁ w₂

namespace lie_module

variables (R : Type u) (L : Type v) (M : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]

/-- The lower central series of Lie submodules of a Lie module. -/
def lower_central_series (k : ℕ) : lie_submodule R L M := (λ I, ⁅(⊤ : lie_ideal R L), I⁆)^[k] ⊤

@[simp] lemma lower_central_series_zero : lower_central_series R L M 0 = ⊤ := rfl

@[simp] lemma lower_central_series_succ (k : ℕ) :
  lower_central_series R L M (k + 1) = ⁅(⊤ : lie_ideal R L), lower_central_series R L M k⁆ :=
function.iterate_succ_apply' (λ I, ⁅(⊤ : lie_ideal R L), I⁆) k ⊤

lemma trivial_iff_lower_central_eq_bot : is_trivial L M ↔ lower_central_series R L M 1 = ⊥ :=
begin
  split; intros h,
  { erw [eq_bot_iff, lie_submodule.lie_span_le], rintros m ⟨x, n, hn⟩, rw [← hn, h.trivial], simp,},
  { rw lie_submodule.eq_bot_iff at h, apply is_trivial.mk, intros x m, apply h,
    apply lie_submodule.subset_lie_span, use [x, m], refl, },
end

lemma iterate_to_endomorphism_mem_lower_central_series (x : L) (m : M) (k : ℕ) :
  (to_endomorphism R L M x)^[k] m ∈ lower_central_series R L M k :=
begin
  induction k with k ih,
  { simp only [function.iterate_zero], },
  { simp only [lower_central_series_succ, function.comp_app, function.iterate_succ',
      to_endomorphism_apply_apply],
    exact lie_submodule.lie_mem_lie _ _ (lie_submodule.mem_top x) ih, },
end

open lie_algebra

lemma derived_series_le_lower_central_series (k : ℕ) :
  derived_series R L k ≤ lower_central_series R L L k :=
begin
  induction k with k h,
  { rw [derived_series_def, derived_series_of_ideal_zero, lower_central_series_zero],
    exact le_refl _, },
  { have h' : derived_series R L k ≤ ⊤, { by simp only [le_top], },
    rw [derived_series_def, derived_series_of_ideal_succ, lower_central_series_succ],
    exact lie_submodule.mono_lie _ _ _ _ h' h, },
end

/-- A Lie module is nilpotent if its lower central series reaches 0 (in a finite number of
steps). -/
class is_nilpotent : Prop :=
(nilpotent : ∃ k, lower_central_series R L M k = ⊥)

@[priority 100]
instance trivial_is_nilpotent [is_trivial L M] : is_nilpotent R L M :=
⟨by { use 1, change ⁅⊤, ⊤⁆ = ⊥, simp, }⟩

lemma nilpotent_endo_of_nilpotent_module [hM : is_nilpotent R L M] :
  ∃ (k : ℕ), ∀ (x : L), (to_endomorphism R L M x)^k = 0 :=
begin
  unfreezingI { obtain ⟨k, hM⟩ := hM, },
  use k,
  intros x, ext m,
  rw [linear_map.pow_apply, linear_map.zero_apply, ← @lie_submodule.mem_bot R L M, ← hM],
  exact iterate_to_endomorphism_mem_lower_central_series R L M x m k,
end

/-- For a nilpotent Lie module, the weight space of the 0 weight is the whole module.

This result will be used downstream to show that weight spaces are Lie submodules, at which time
it will be possible to state it in the language of weight spaces. -/
lemma infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L M] :
  (⨅ (x : L), (to_endomorphism R L M x).maximal_generalized_eigenspace 0) = ⊤ :=
begin
  ext m,
  simp only [module.End.mem_maximal_generalized_eigenspace, submodule.mem_top, sub_zero, iff_true,
    zero_smul, submodule.mem_infi],
  intros x,
  obtain ⟨k, hk⟩ := nilpotent_endo_of_nilpotent_module R L M,
  use k, rw hk,
  exact linear_map.zero_apply m,
end

end lie_module

@[priority 100]
instance lie_algebra.is_solvable_of_is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [hL : lie_module.is_nilpotent R L L] :
  lie_algebra.is_solvable R L :=
begin
  obtain ⟨k, h⟩ : ∃ k, lie_module.lower_central_series R L L k = ⊥ := hL.nilpotent,
  use k, rw ← le_bot_iff at h ⊢,
  exact le_trans (lie_module.derived_series_le_lower_central_series R L k) h,
end

section nilpotent_algebras

variables (R : Type u) (L : Type v) (L' : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']

/-- We say a Lie algebra is nilpotent when it is nilpotent as a Lie module over itself via the
adjoint representation. -/
abbreviation lie_algebra.is_nilpotent (R : Type u) (L : Type v)
  [comm_ring R] [lie_ring L] [lie_algebra R L] : Prop :=
lie_module.is_nilpotent R L L

open lie_algebra

lemma lie_algebra.nilpotent_ad_of_nilpotent_algebra [is_nilpotent R L] :
  ∃ (k : ℕ), ∀ (x : L), (ad R L x)^k = 0 :=
lie_module.nilpotent_endo_of_nilpotent_module R L L

/-- See also `lie_algebra.zero_root_space_eq_top_of_nilpotent`. -/
lemma lie_algebra.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent [is_nilpotent R L] :
  (⨅ (x : L), (ad R L x).maximal_generalized_eigenspace 0) = ⊤ :=
lie_module.infi_max_gen_zero_eigenspace_eq_top_of_nilpotent R L L

-- TODO Generalise the below to Lie modules if / when we define morphisms, equivs of Lie modules
-- covering a Lie algebra morphism of (possibly different) Lie algebras.

variables {R L L'}

open lie_module (lower_central_series)

lemma lie_ideal.lower_central_series_map_le (k : ℕ) {f : L →ₗ⁅R⁆ L'} :
  lie_ideal.map f (lower_central_series R L L k) ≤ lower_central_series R L' L' k :=
begin
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero, le_top], },
  { simp only [lie_module.lower_central_series_succ],
    exact le_trans (lie_ideal.map_bracket_le f) (lie_submodule.mono_lie _ _ _ _ le_top ih), },
end

lemma lie_ideal.lower_central_series_map_eq (k : ℕ) {f : L →ₗ⁅R⁆ L'}
  (h : function.surjective f) :
  lie_ideal.map f (lower_central_series R L L k) = lower_central_series R L' L' k :=
begin
  have h' : (⊤ : lie_ideal R L).map f = ⊤,
  { rw ←f.ideal_range_eq_map,
    exact f.ideal_range_eq_top_of_surjective h, },
  induction k with k ih,
  { simp only [lie_module.lower_central_series_zero], exact h', },
  { simp only [lie_module.lower_central_series_succ, lie_ideal.map_bracket_eq f h, ih, h'], },
end

lemma function.injective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L'] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.injective f) : is_nilpotent R L :=
{ nilpotent :=
  begin
    tactic.unfreeze_local_instances, obtain ⟨k, hk⟩ := h₁,
    use k,
    apply lie_ideal.bot_of_map_eq_bot h₂, rw [eq_bot_iff, ← hk],
    apply lie_ideal.lower_central_series_map_le,
  end, }

lemma function.surjective.lie_algebra_is_nilpotent [h₁ : is_nilpotent R L] {f : L →ₗ⁅R⁆ L'}
  (h₂ : function.surjective f) : is_nilpotent R L' :=
{ nilpotent :=
  begin
    tactic.unfreeze_local_instances, obtain ⟨k, hk⟩ := h₁,
    use k,
    rw [← lie_ideal.lower_central_series_map_eq k h₂, hk],
    simp only [lie_ideal.map_eq_bot_iff, bot_le],
  end, }

lemma lie_equiv.nilpotent_iff_equiv_nilpotent (e : L ≃ₗ⁅R⁆ L') :
  is_nilpotent R L ↔ is_nilpotent R L' :=
begin
  split; introsI h,
  { exact e.symm.injective.lie_algebra_is_nilpotent, },
  { exact e.injective.lie_algebra_is_nilpotent, },
end

instance [h : lie_algebra.is_nilpotent R L] : lie_algebra.is_nilpotent R (⊤ : lie_subalgebra R L) :=
lie_subalgebra.top_equiv_self.nilpotent_iff_equiv_nilpotent.mpr h

end nilpotent_algebras

section of_associative

variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]

lemma lie_algebra.ad_nilpotent_of_nilpotent {a : A} (h : is_nilpotent a) :
  is_nilpotent (lie_algebra.ad R A a) :=
begin
  rw lie_algebra.ad_eq_lmul_left_sub_lmul_right,
  have hl : is_nilpotent (algebra.lmul_left R a), { rwa algebra.is_nilpotent_lmul_left_iff, },
  have hr : is_nilpotent (algebra.lmul_right R a), { rwa algebra.is_nilpotent_lmul_right_iff, },
  exact (algebra.commute_lmul_left_right R a a).is_nilpotent_sub hl hr,
end

variables {R}

lemma lie_subalgebra.is_nilpotent_ad_of_is_nilpotent_ad {L : Type v} [lie_ring L] [lie_algebra R L]
  (K : lie_subalgebra R L) {x : K} (h : is_nilpotent (lie_algebra.ad R L ↑x)) :
  is_nilpotent (lie_algebra.ad R K x) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  exact linear_map.submodule_pow_eq_zero_of_pow_eq_zero (K.ad_comp_incl_eq x) hn,
end

lemma lie_algebra.is_nilpotent_ad_of_is_nilpotent {L : lie_subalgebra R A} {x : L}
  (h : is_nilpotent (x : A)) : is_nilpotent (lie_algebra.ad R L x) :=
L.is_nilpotent_ad_of_is_nilpotent_ad $ lie_algebra.ad_nilpotent_of_nilpotent R h

end of_associative


import SciLean.Math.Symbolic.Basic
import SciLean.Math.Symbolic.Monomial

--- TODO: rename `V` to `I` or `ι` as it is clear it is an index set not a module

namespace SciLean

open Symbolic

def FreeAlgebra (V : Type) (K : Type) [Add K] [Mul K] [One K] [Neg K]
  :=
  Quot
  (λ x y : Expr V K =>
    (Expr.EqAlgebra x y))

namespace FreeAlgebra

  variable {V : Type} {K : Type} [Add K] [Mul K] [One K] [Neg K]

  namespace Expr

    open Symbolic.Expr

    def toString [ToString V] [ToString K] (e : Expr V K): String :=
      match e with
      | zero => "0"
      | one  => "1"
      | var v => s!"e⟦{v}⟧"
      | neg x => s!"- {toString x}"
      | add x y => s!"({toString x} + {toString y})"
      | mul x y => s!"{toString x} ⊗ {toString y}"
      | smul a x => s!"{a} {toString x}"

    -- Operations normalizing arithmetics on K and scalar multiplication
    -- However they do not apply associativity or distributivity
    -- Do we to apply associativity?
    -- Distributivity definitely not, for example we want to keep
    -- polynomials in Horner form 1 + x * (1 + x * (1 + x)) for faster evaluation

    def add : Expr V K → Expr V K → Expr V K
      | x, 0 => x
      | 0, y => y
      | x, y => x + y

    def sub : Expr V K → Expr V K → Expr V K
      | x, 0 => x
      | 0, y => - y
      | x, - y => x + y
      | x, smul a y => x + (-a) * y
      | x, y => x + - y

    def mul : Expr V K → Expr V K → Expr V K
      | 0, y => 0
      | x, 0 => 0
      | 1, y => y
      | x, 1 => x
      | smul a x, smul b y => (a*b) * (x*y)
      | smul a x, neg y => (-a) * (x*y)
      | neg x, smul b y => (-b) * (x*y)
      | neg x, neg y => x*y
      | smul a x, y => a * (x*y)
      | x, smul b y => b * (x*y)
      | neg x, y => neg (x*y)
      | x, neg y => neg (x*y)
      | x, y => x*y

    def neg : Expr V K → Expr V K
      | - 0 => 0
      | - x => x
      | smul a x => (-a) * x
      | x => - x

    -- If we add decidable equalitye we can check for a == 1
    def smul : K → Expr V K → Expr V K
      | a, 0 => 0
      | a, -x => (-a) * x
      | a, Expr.smul b x => (a*b) * x
      | a, x => a * x

  end Expr

  instance : Add (FreeAlgebra V K) :=
    ⟨λ x y => Quot.mk _ <| Quot.lift₂ Expr.add sorry sorry x y⟩

  instance : Sub (FreeAlgebra V K) :=
    ⟨λ x y => Quot.mk _ <| Quot.lift₂ Expr.sub sorry sorry x y⟩

  instance : Mul (FreeAlgebra V K) :=
    ⟨λ x y => Quot.mk _ <| Quot.lift₂ Expr.mul sorry sorry x y⟩

  instance : Neg (FreeAlgebra V K) :=
    ⟨λ x => Quot.mk _ <| Quot.lift Expr.neg sorry x⟩

  instance : HMul K (FreeAlgebra V K) (FreeAlgebra V K) :=
    ⟨λ a x => Quot.mk _ <| Quot.lift (Expr.smul a) sorry x⟩

  instance : Zero (FreeAlgebra V K) := ⟨Quot.mk _ 0⟩
  instance : One  (FreeAlgebra V K) := ⟨Quot.mk _ 1⟩

  -- The string actually depends on the represenative element, thus it has to be hidden behind an opaque constant
  -- The sorry here is impossible to be proven
  constant toString [ToString V] [ToString K] (p : FreeAlgebra V K) : String :=
    Quot.lift (λ e : Expr V K => Expr.toString e) sorry p

  instance [ToString V] [ToString K]: ToString (FreeAlgebra V K) := ⟨toString⟩

  def toVal {R} [Ring R] (p : FreeAlgebra V R) (vars : V → R) : R :=
    Quot.lift (λ e => e.toVal vars) sorry p

  def var {V} (v : V) (K := ℝ) [Add K] [Mul K] [One K] [Neg K] : FreeAlgebra V K
    := Quot.mk _ (Expr.var v)

  def expand {ι} [Zero K]
    (x : FreeAlgebra ι K) : FreeAlgebra ι K :=
    Quot.mk _ <|
    Quot.lift Expr.expand sorry x

  open Symbolic.Expr Monomial in
  def simplify {ι} [Zero K]  [Inhabited K]
    [LT ι] [∀ i j : ι, Decidable (i < j)] [DecidableEq ι]
    [LT K] [∀ a b : K, Decidable (a < b)] [DecidableEq K]
    (x : FreeAlgebra ι K) : FreeAlgebra ι K :=
    Quot.mk _ <|
    Quot.lift
      (λ e : Expr ι K =>
         e |> expand_to_monomials
           |> (Array.qsort · Monomial.decLt)
           |> together
           |> Expr.simplify
      )
      sorry x

  notation " 𝓕[" ι ", " K "] " => FreeAlgebra ι K
  notation " 𝓕[" ι "] "        => FreeAlgebra ι ℝ
  -- notation " 𝓣[" V "] "        => FreeAlgebra (Basis.index V) ℝ

  notation " e⟦" v ", " K "⟧ " => var v (K := K)
  notation " e⟦" v "⟧ "        => var v

  def x := (2 : ℝ) * e⟦0⟧ * ((3 : ℝ) * ((1: ℝ) * e⟦1⟧ + (2 : ℝ) * e⟦-3⟧))
  def y := (((e⟦0⟧ + e⟦1⟧) * e⟦0⟧ + e⟦1⟧) * e⟦2⟧)

  #eval x
  #eval x.expand
  #eval y
  #eval y.expand

end FreeAlgebra


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_11
  (a b : ℝ)
  (h₀ : a ≠ b)
  (h₁ : a ≠ 2*b)
  (h₂ : (4 * a + 3 * b) / (a - 2 * b) = 5) :
  (a + 11 * b) / (a - b) = 2 :=
begin
  field_simp [*, sub_ne_zero, mul_assoc, mul_comm] at *,
  linarith,
end


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.ring_theory.ideal.basic
import Mathlib.PostPort

universes u l v w

namespace Mathlib

/-!
# Invariant basis number property

We say that a ring `R` satisfies the invariant basis number property if there is a well-defined
notion of the rank of a finitely generated free (left) `R`-module. Since a finitely generated free
module with a basis consisting of `n` elements is linearly equivalent to `fin n → R`, it is
sufficient that `(fin n → R) ≃ₗ[R] (fin m → R)` implies `n = m`.

## Main definitions

`invariant_basis_number R` is a type class stating that `R` has the invariant basis number property.

## Main results

We show that every nontrivial commutative ring has the invariant basis number property.

## Future work

So far, there is no API at all for the `invariant_basis_number` class. There are several natural
ways to formulate that a module `M` is finitely generated and free, for example
`M ≃ₗ[R] (fin n → R)`, `M ≃ₗ[R] (ι → R)`, where `ι` is a fintype, or prividing a basis indexed by
a finite type. There should be lemmas applying the invariant basis number property to each
situation.

The finite version of the invariant basis number property implies the infinite analogue, i.e., that
`(ι →₀ R) ≃ₗ[R] (ι' →₀ R)` implies that `cardinal.mk ι = cardinal.mk ι'`. This fact (and its
variants) should be formalized.

## References

* https://en.wikipedia.org/wiki/Invariant_basis_number

## Tags

free module, rank, invariant basis number, IBN

-/

/-- We say that `R` has the invariant basis number property if `(fin n → R) ≃ₗ[R] (fin m → R)`
    implies `n = m`. This gives rise to a well-defined notion of rank of a finitely generated free
    module. -/
class invariant_basis_number (R : Type u) [ring R]
where
  eq_of_fin_equiv : ∀ {n m : ℕ}, linear_equiv R (fin n → R) (fin m → R) → n = m

theorem eq_of_fin_equiv (R : Type u) [ring R] [invariant_basis_number R] {n : ℕ} {m : ℕ} : linear_equiv R (fin n → R) (fin m → R) → n = m :=
  invariant_basis_number.eq_of_fin_equiv

theorem nontrivial_of_invariant_basis_number (R : Type u) [ring R] [invariant_basis_number R] : nontrivial R := sorry

/-- A field has invariant basis number. This will be superseded below by the fact that any nonzero
    commutative ring has invariant basis number. -/
theorem invariant_basis_number_field {K : Type u} [field K] : invariant_basis_number K := sorry

/-!
  We want to show that nontrivial commutative rings have invariant basis number. The idea is to
  take a maximal ideal `I` of `R` and use an isomorphism `R^n ≃ R^m` of `R` modules to produce an
  isomorphism `(R/I)^n ≃ (R/I)^m` of `R/I`-modules, which will imply `n = m` since `R/I` is a field
  and we know that fields have invariant basis number.

  We construct the isomorphism in two steps:
  1. We construct the ring `R^n/I^n`, show that it is an `R/I`-module and show that there is an
     isomorphism of `R/I`-modules `R^n/I^n ≃ (R/I)^n`. This isomorphism is called
    `ideal.pi_quot_equiv` and is located in the file `ring_theory/ideals.lean`.
  2. We construct an isomorphism of `R/I`-modules `R^n/I^n ≃ R^m/I^m` using the isomorphism
     `R^n ≃ R^m`.
-/

/-- An `R`-linear map `R^n → R^m` induces a function `R^n/I^n → R^m/I^m`. -/
/-- An isomorphism of `R`-modules `R^n ≃ R^m` induces an isomorphism `R/I`-modules
    `R^n/I^n ≃ R^m/I^m`. -/
/-- Nontrivial commutative rings have the invariant basis number property. -/
protected instance invariant_basis_number_of_nontrivial_of_comm_ring {R : Type u} [comm_ring R] [nontrivial R] : invariant_basis_number R :=
  invariant_basis_number.mk fun (n m : ℕ) (e : linear_equiv R (fin n → R) (fin m → R)) => sorry


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.nat_antidiagonal
import Mathlib.algebra.big_operators.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Big operators for `nat_antidiagonal`

This file contains theorems relevant to big operators over `finset.nat.antidiagonal`.
-/

namespace finset

namespace nat

theorem prod_antidiagonal_succ {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} : (finset.prod (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
  f (0, n + 1) * finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p + 1, prod.snd p) := sorry

theorem sum_antidiagonal_succ {N : Type u_2} [add_comm_monoid N] {n : ℕ} {f : ℕ × ℕ → N} : (finset.sum (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
  f (0, n + 1) + finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p + 1, prod.snd p) :=
  prod_antidiagonal_succ

theorem sum_antidiagonal_swap {M : Type u_1} [add_comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} : (finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.swap p)) = finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f p := sorry

theorem prod_antidiagonal_succ' {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} : (finset.prod (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
  f (n + 1, 0) * finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p, prod.snd p + 1) := sorry

theorem sum_antidiagonal_succ' {N : Type u_2} [add_comm_monoid N] {n : ℕ} {f : ℕ × ℕ → N} : (finset.sum (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
  f (n + 1, 0) + finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p, prod.snd p + 1) :=
  prod_antidiagonal_succ'

theorem prod_antidiagonal_subst {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → ℕ → M} : (finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f p n) =
  finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f p (prod.fst p + prod.snd p) := sorry

theorem prod_antidiagonal_eq_prod_range_succ {M : Type u_1} [comm_monoid M] (f : ℕ → ℕ → M) (n : ℕ) : (finset.prod (antidiagonal n) fun (ij : ℕ × ℕ) => f (prod.fst ij) (prod.snd ij)) =
  finset.prod (range (Nat.succ n)) fun (k : ℕ) => f k (n - k) := sorry


theorem ExF001{X : Type}(P Q : X → Prop)(a : X): P a → Q a → ∃x, P x ∧ Q x :=

assume H1:P a,
  assume H2:Q a,
  have A:P a ∧ Q a, from and.intro H1 H2,
  show ∃x, P x ∧ Q x, from exists.intro a A


import .lib

/- * Parameterization by the word size, in bits. -/

namespace word
section
variable (n : ℕ)

def wordsize : ℕ := n

def modulus : ℕ := 2^wordsize n
def half_modulus : ℕ := 2^(wordsize n - 1)
def max_unsigned : ℕ := modulus n - 1
def max_signed : ℕ := half_modulus n - 1
def min_signed : ℤ := - half_modulus n

theorem modulus_pos : modulus n > 0 := nat.pos_pow_of_pos _ dec_trivial

theorem succ_max_unsigned : nat.succ (max_unsigned n) = modulus n :=
nat.succ_pred_eq_of_pos (modulus_pos _)
end
end word

/- * Representation of machine integers -/

/- A machine integer (type [word]) is represented as an arbitrary-precision
  natural number (type [nat]) plus a proof that it is less than [modulus]. -/

def word (n) := fin (word.modulus n)

namespace word

def repr {w} (x : ℤ) : word w :=
⟨x.nat_mod (modulus w), sorry'⟩

instance coe_int_word {w} : has_coe ℤ (word w) := ⟨repr⟩

/- The [unsigned] and [signed] functions return the Coq integer corresponding
  to the given machine integer, interpreted as unsigned or signed
  respectively. -/

def unsigned {w} (n : word w) : ℕ := n.1

section

parameter {wordsize : ℕ}

local notation `modulus` := modulus wordsize
local notation `half_modulus` := half_modulus wordsize
local notation `max_unsigned` := max_unsigned wordsize
local notation `max_signed` := max_signed wordsize
local notation `min_signed` := min_signed wordsize
local notation `word` := word wordsize
local notation `repr` := @repr wordsize
local notation `unsigned` := @unsigned wordsize

def signed (n : word) : ℤ :=
let x := unsigned n in
if x < half_modulus then x else x - modulus
instance coe_word_int : has_coe word ℤ := ⟨signed⟩

/- Conversely, [repr] takes a Coq integer and returns the corresponding
  machine integer.  The argument is treated modulo [modulus]. -/

def in_srange (x : ℤ) : bool := min_signed ≤ x ∧ x < half_modulus
def in_urange (x : ℕ) : bool := x < modulus

def iwordsize := repr wordsize

instance : has_zero word := ⟨repr 0⟩
instance : has_one word := ⟨repr 1⟩

instance eq_dec : decidable_eq word := by tactic.mk_dec_eq_instance

/- * Arithmetic and logical operations over machine integers -/

def ltu (x y : word) : Prop := unsigned x < unsigned y
def leu (x y : word) : Prop := unsigned x ≤ unsigned y
instance : has_lt word := ⟨λx y, signed x < signed y⟩
instance : has_le word := ⟨λx y, signed x ≤ signed y⟩

protected def neg (x : word) : word := repr (-unsigned x)
instance : has_neg word := ⟨word.neg⟩

protected def add (x y : word) : word := repr (unsigned x + unsigned y)
protected def mul (x y : word) : word := repr (unsigned x * unsigned y)
instance : has_add word := ⟨word.add⟩
instance : has_mul word := ⟨word.mul⟩

def divs (x y : word) : word := repr (int.quot (signed x) (signed y))
def mods (x y : word) : word := repr (int.rem  (signed x) (signed y))
instance : has_div word := ⟨divs⟩
instance : has_mod word := ⟨mods⟩

def divu (x y : word) : word := repr (unsigned x / unsigned y : ℕ)
def modu (x y : word) : word := repr (unsigned x % unsigned y : ℕ)

/- Bitwise boolean operations. -/

protected def and (x y : word) : word := repr (int.land (unsigned x) (unsigned y))
protected def or  (x y : word) : word := repr (int.lor  (unsigned x) (unsigned y))
protected def xor (x y : word) : word := repr (int.lxor (unsigned x) (unsigned y))

protected def not (x : word) : word := repr (int.lnot (unsigned x))

/- Shifts and rotates. -/

def shl  (x y : word) : word := repr (int.shiftl (unsigned x) (unsigned y))
def shru (x y : word) : word := repr (int.shiftr (unsigned x) (unsigned y))
def shr  (x y : word) : word := repr (int.shiftr (signed x)   (unsigned y))

def rol (x y : word) : word :=
let n := unsigned y % wordsize in
repr (int.lor (int.shiftl (unsigned x) n) (int.shiftr (unsigned x) (wordsize - n)))
def ror (x y : word) : word :=
let n := unsigned y % wordsize in
repr (int.lor (int.shiftr (unsigned x) n) (int.shiftl (unsigned x) (wordsize - n)))

def rolm (x a m : word) : word := word.and (rol x a) m

/- Viewed as signed divisions by powers of two, [shrx] rounds towards
  zero, while [shr] rounds towards minus infinity. -/

def shrx (x y : word) : word := x / shl 1 y

/- High half of full multiply. -/

def mulhu (x y : word) : word := repr ((unsigned x * unsigned y) / modulus)
def mulhs (x y : word) : word := repr ((signed x * signed y) / modulus)

instance coe_bool_word : has_coe bool word := ⟨λb, cond b 1 0⟩

/- Condition flags -/

def negative (x : word) : word := to_bool (x < 0)

def add_carry (x y cin : word) : word :=
to_bool (unsigned x + unsigned y + unsigned cin ≥ modulus)

def add_overflow (x y cin : word) : word :=
bnot $ in_srange (signed x + signed y + signed cin)

def sub_borrow (x y bin : word) : word :=
to_bool (unsigned x - unsigned y - unsigned bin < 0)

def sub_overflow (x y bin : word) : word :=
bnot $ in_srange (signed x - signed y - signed bin)

/- [shr_carry x y] is 1 if [x] is negative and at least one 1 bit is shifted away. -/

def shr_carry (x y : word) : word :=
to_bool (x < 0 ∧ and x (shl 1 y + -1) ≠ 0)

/- Zero and sign extensions -/

def zero_ext (n : ℕ) (x : word) : word := repr (unsigned x % 2^n)

def sign_ext (n : ℕ+) (x : word) : word :=
let modulus' := 2^n.1, y := unsigned x % modulus' in
repr (if y < modulus'/2 then y else y - modulus')

/- Decomposition of a number as a sum of powers of two. -/

def one_bits (x : word) : list word :=
(num.one_bits (unsigned x)).map (λx:ℕ, repr x)

/- Recognition of powers of two. -/

def is_power2 (x : word) : option word :=
match num.one_bits (unsigned x) with
| (i :: []) := some (repr i)
| _ := none
end

/- Comparisons. -/

instance decidable_lt : @decidable_rel word (<) := by apply_instance
instance decidable_le : @decidable_rel word (≤) := by apply_instance
instance decidable_ltu : decidable_rel ltu := by delta ltu; apply_instance
instance decidable_leu : decidable_rel leu := by delta leu; apply_instance

def cmp : comparison → word → word → bool
| Ceq x y := x = y
| Cne x y := x ≠ y
| Clt x y := x < y
| Cle x y := x ≤ y
| Cgt x y := y < x
| Cge x y := y ≤ x

def cmpu : comparison → word → word → bool
| Ceq x y := x = y
| Cne x y := x ≠ y
| Clt x y := ltu x y
| Cle x y := bnot (ltu y x)
| Cgt x y := ltu y x
| Cge x y := bnot (ltu x y)

def is_false (x : word) : Prop := x = 0
def is_true  (x : word) : Prop := x ≠ 0
def notbool  (x : word) : word  := to_bool (x = 0)

/- x86-style extended division and modulus -/

def divmodu2 (nhi nlo : word) (d : word) : option (word × word) :=
if d = 0 then none else
  let q := unsigned nhi * modulus + unsigned nlo / unsigned d in
  if q < modulus then
    some (repr q, repr (unsigned nhi * modulus + unsigned nlo % unsigned d))
  else none

def divmods2 (nhi nlo : word) (d : word) : option (word × word) :=
if d = 0 then none else
  let q := int.quot (signed nhi * modulus + unsigned nlo) (signed d) in
  if in_srange q then
    some (repr q, repr (int.rem (signed nhi * modulus + unsigned nlo) (signed d)))
  else none

/- Encode and decode from an integer -/

def words_of_int : ℕ → ℤ → list word
| 0       x := []
| (m + 1) x := repr x :: words_of_int m (x / modulus)

def nat_of_words : list word → ℕ
| []        := 0
| (b :: l') := unsigned b + nat_of_words l' * modulus

/- * Properties of integers and integer arithmetic -/

/- Relative positions, from greatest to smallest:
<<
      max_unsigned
      max_signed
      2*wordsize-1
      wordsize
      0
      min_signed
>>
-/

theorem half_modulus_pos : half_modulus > 0 := nat.pos_pow_of_pos _ dec_trivial

theorem min_signed_neg : min_signed < 0 := sorry'

theorem max_signed_pos : max_signed ≥ 0 := sorry'

theorem two_wordsize_max_unsigned : 2 * wordsize - 1 ≤ max_unsigned := sorry'

theorem max_signed_unsigned : max_signed < max_unsigned := sorry'

@[simp] lemma unsigned_repr_eq (x) : unsigned (repr x) = x.nat_mod modulus := sorry'

lemma signed_repr_eq (x) : signed (repr x) =
  if x.nat_mod modulus < half_modulus then x.nat_mod modulus else x.nat_mod modulus - modulus := sorry'

lemma mod_eq_of_repr_eq {x y} (h : repr x = repr y) : x.nat_mod modulus = y.nat_mod modulus :=
let t := congr_arg unsigned h in
by simp at t; simp [t]

theorem unsigned_range (i) : unsigned i < modulus := sorry'

theorem unsigned_range_2 (i) : unsigned i ≤ max_unsigned := sorry'

theorem min_signed_range (i) : min_signed ≤ signed i := sorry'

theorem max_signed_range (i) : signed i ≤ max_signed := sorry'

@[simp] theorem repr_unsigned (i) : repr (unsigned i) = i := sorry'

@[simp] theorem repr_signed (i) : repr (signed i) = i := sorry'

theorem unsigned_repr {z} (h : z ≤ max_unsigned) : unsigned (repr z) = z := sorry'

theorem signed_repr {z} : min_signed ≤ z → z ≤ max_signed → signed (repr z) = z := sorry'

theorem signed_eq_unsigned (x) : unsigned x ≤ max_signed → signed x = unsigned x := sorry'

theorem signed_positive (x) : 0 ≤ signed x ↔ unsigned x ≤ max_signed := sorry'

/- ** Properties of zero, one, minus one -/

theorem unsigned_zero : unsigned 0 = 0 := sorry'

theorem unsigned_mone : unsigned (-1) = modulus - 1 := sorry'

theorem signed_zero : signed 0 = 0 := sorry'

theorem signed_mone : signed (-1) = -1 := sorry'

theorem unsigned_repr_wordsize : unsigned iwordsize = wordsize := sorry'

/- ** Properties of equality -/

theorem eq_signed (x y) : x = y ↔ signed x = signed y := sorry'

theorem eq_unsigned (x y) : x = y ↔ unsigned x = unsigned y := sorry'

/- ** Properties of addition -/

theorem add_unsigned (x y) : x + y = repr (unsigned x + unsigned y) := sorry'

theorem add_signed (x y) : x + y = repr (signed x + signed y) := sorry'

theorem add_comm (x y : word) : x + y = y + x := sorry'

theorem add_zero (x : word) : x + 0 = x := sorry'

theorem add_assoc (x y z : word) : (x + y) + z = x + (y + z) := sorry'

theorem add_left_neg (x : word) : -x + x = 0 := sorry'

theorem unsigned_add_carry (x y) :
  unsigned (x + y) = unsigned x + unsigned y - unsigned (add_carry x y 0) * modulus := sorry'

theorem unsigned_add_either (x y) :
  unsigned (x + y) = unsigned x + unsigned y
  ∨ (unsigned (x + y) : ℤ) = unsigned x + unsigned y - modulus := sorry'

/- ** Properties of negation -/

theorem neg_repr (z) : -(repr z) = repr (-z) := sorry'

/- ** Properties of multiplication -/

theorem mul_comm (x y : word) : x * y = y * x := sorry'

theorem mul_one (x : word) : x * 1 = x := sorry'

theorem mul_assoc (x y z : word) : (x * y) * z = x * (y * z) := sorry'

theorem right_distrib (x y z : word) : (x + y) * z = x * z + y * z := sorry'

theorem mul_signed (x y) : x * y = repr (signed x * signed y) := sorry'

instance comm_ring : comm_ring word :=
{ add            := (+),
  add_assoc      := add_assoc,
  zero           := 0,
  zero_add       := λx, by rw [add_comm, add_zero],
  add_zero       := add_zero,
  neg            := has_neg.neg,
  add_left_neg   := add_left_neg,
  add_comm       := add_comm,
  mul            := (*),
  mul_assoc      := mul_assoc,
  one            := 1,
  one_mul        := λx, by rw [mul_comm, mul_one],
  mul_one        := mul_one,
  left_distrib   := λx y z,
    by rw [mul_comm, right_distrib, mul_comm y x, mul_comm z x]; refl,
  right_distrib  := right_distrib,
  mul_comm       := mul_comm }

/- ** Properties of subtraction -/

theorem sub_unsigned (x y) : x - y = repr (unsigned x - unsigned y) := sorry'

theorem sub_signed (x y) : x - y = repr (signed x - signed y) := sorry'

theorem unsigned_sub_borrow (x y) : unsigned (x - y) =
  unsigned x - unsigned y + unsigned (sub_borrow x y 0) * modulus := sorry'

/- ** Properties of division and modulus -/

lemma divu_add_modu (x y) : y ≠ 0 → divu x y * y + modu x y = x := sorry'

theorem modu_divu (x y) : y ≠ 0 → modu x y = x - divu x y * y := sorry'

lemma mods_divs_Euclid (x y : word) : x / y * y + x % y = x := sorry'

theorem mods_divs (x y : word) : x % y = x - x / y * y := sorry'

theorem divu_one (x) : divu x 1 = x := sorry'

theorem modu_one (x) : modu x 1 = 0 := sorry'

theorem divs_mone (x : word) : x / (-1) = -x := sorry'

theorem mods_mone (x : word) : x % (-1) = 0 := sorry'

theorem divmodu2_divu_modu (n d) :
  d ≠ 0 → divmodu2 0 n d = some (divu n d, modu n d) := sorry'

lemma unsigned_signed (n) : (unsigned n : ℤ) =
  if n < 0 then signed n + modulus else signed n := sorry'

theorem divmods2_divs_mods (n d) :
  d ≠ 0 → n ≠ repr min_signed ∨ d ≠ -1 →
  divmods2 (if n < 0 then -1 else 0) n d = some (divs n d, mods n d) := sorry'

/- ** Bit-level properties -/

/- ** Bit-level reasoning over type [int] -/

def test_bit (x : word) (i : ℕ) : bool := int.test_bit (unsigned x) i

lemma test_bit_repr (x i) : i < wordsize →
  test_bit (repr x) i = int.test_bit x i := sorry'

lemma same_bits_eq (x y) :
  (∀ i < wordsize, test_bit x i = test_bit y i) →
  x = y := sorry'

lemma bits_above (x i) : i ≥ wordsize → test_bit x i = ff := sorry'

lemma bits_zero (i) : test_bit 0 i = ff := sorry'

theorem bits_one (n) : test_bit 1 n = to_bool (n = 0) := sorry'

lemma bits_mone (i) : i < wordsize → test_bit (-1) i := sorry'

lemma sign_bit_of_unsigned (x) : test_bit x (wordsize - 1) =
  to_bool (unsigned x ≥ half_modulus) := sorry'

lemma bits_signed (x i) : int.test_bit (signed x) i =
  test_bit x (if i < wordsize then i else wordsize - 1) := sorry'

lemma bits_le (x y) :
  (∀ i < wordsize, test_bit x i → test_bit y i) →
  unsigned x ≤ unsigned y := sorry'

/- ** Properties of bitwise and, or, xor -/

@[simp] lemma bits_and (x y i) : i < wordsize →
  test_bit (word.and x y) i = test_bit x i && test_bit y i := sorry'

@[simp] lemma bits_or (x y i) : i < wordsize →
  test_bit (word.or x y) i = test_bit x i || test_bit y i := sorry'

@[simp] lemma bits_xor (x y i) : i < wordsize →
  test_bit (word.xor x y) i = bxor (test_bit x i) (test_bit y i) := sorry'

@[simp] lemma bits_not (x i) : i < wordsize →
  test_bit (word.not x) i = bnot (test_bit x i) := sorry'

theorem and_comm (x y) : word.and x y = word.and y x := sorry'

theorem and_assoc (x y z) : word.and (word.and x y) z = word.and x (word.and y z) := sorry'

@[simp] theorem and_zero (x) : word.and x 0 = 0 := sorry'

@[simp] theorem zero_and (x) : word.and 0 x = 0 := sorry'

@[simp] theorem and_mone (x) : word.and x (-1) = x := sorry'

@[simp] theorem mone_and (x) : word.and (-1) x = x := sorry'

@[simp] theorem and_self (x) : and x x = x := sorry'

theorem or_comm (x y) : word.or x y = word.or y x := sorry'

theorem or_assoc (x y z) : word.or (word.or x y) z = word.or x (word.or y z) := sorry'

@[simp] theorem or_zero (x) : word.or x 0 = x := sorry'

@[simp] theorem zero_or (x) : word.or 0 x = x := sorry'

@[simp] theorem or_mone (x) : word.or x (-1) = -1 := sorry'

@[simp] theorem or_self (x) : word.or x x = x := sorry'

theorem and_or_left_distrib (x y z) :
  word.and x (word.or y z) = word.or (word.and x y) (word.and x z) := sorry'

theorem and_or_right_distrib (x y z) :
  word.and (word.or x y) z = word.or (word.and x z) (word.and y z) := sorry'

theorem or_and_left_distrib (x y z) :
  word.or x (word.and y z) = word.and (word.or x y) (word.or x z) := sorry'

theorem or_and_right_distrib (x y z) :
  word.or (word.and x y) z = word.and (word.or x z) (word.or y z) := sorry'

@[simp] theorem and_or_absorb (x y) : word.and x (word.or x y) = x := sorry'

@[simp] theorem or_and_absorb (x y) : word.or x (word.and x y) = x := sorry'

theorem xor_comm (x y) : word.xor x y = word.xor y x := sorry'

theorem xor_assoc (x y z) : word.xor (word.xor x y) z = word.xor x (word.xor y z) := sorry'

@[simp] theorem xor_zero (x) : word.xor x 0 = x := sorry'

@[simp] theorem zero_xor (x) : word.xor 0 x = x := sorry'

@[simp] theorem xor_self (x) : word.xor x x = 0 := sorry'

@[simp] theorem xor_zero_one : word.xor 0 1 = 1 := zero_xor _

@[simp] theorem xor_one_one : word.xor 1 1 = 0 := xor_self _

theorem eq_of_xor_zero (x y) : word.xor x y = 0 → x = y := sorry'

theorem and_xor_distrib (x y z) :
  word.and x (word.xor y z) = word.xor (word.and x y) (word.and x z) := sorry'

theorem and_le (x y) : unsigned (word.and x y) ≤ unsigned x := sorry'

theorem or_le (x y) : unsigned x ≤ unsigned (word.or x y) := sorry'

/- Properties of bitwise complement.-/

theorem not_not (x) : word.not (word.not x) = x := sorry'

theorem not_zero : word.not 0 = -1 := sorry'

theorem not_mone : word.not (-1) = 0 := sorry'

theorem not_or_and_not (x y) : word.not (word.or x y) = word.and (word.not x) (word.not y) := sorry'

theorem not_and_or_not (x y) : word.not (word.and x y) = word.or (word.not x) (word.not y) := sorry'

theorem and_not_self (x) : word.and x (word.not x) = 0 := sorry'

theorem or_not_self (x) : word.or x (word.not x) = -1 := sorry'

theorem xor_not_self (x) : word.xor x (word.not x) = -1 := sorry'

lemma unsigned_not (x) : unsigned (word.not x) = max_unsigned - unsigned x := sorry'

theorem not_neg (x) : word.not x = -x - 1 := sorry'

theorem neg_not (x) : -x = word.not x + 1 := sorry'

theorem sub_add_not (x y) : x - y = x + word.not y + 1 := sorry'

theorem sub_add_not_3 (x y b) : b = 0 ∨ b = 1 →
  x - y - b = x + word.not y + word.xor b 1 := sorry'

theorem sub_borrow_add_carry (x y b) : b = 0 ∨ b = 1 →
  sub_borrow x y b = word.xor (add_carry x (word.not y) (word.xor b 1)) 1 := sorry'

/- Connections between [add] and bitwise logical operations. -/

lemma Z_add_is_or (i x y) :
  (∀ j ≤ i, int.test_bit x j && int.test_bit y j = ff) →
  int.test_bit (x + y) i = int.test_bit x i || int.test_bit y i := sorry'

theorem add_is_or (x y) : word.and x y = 0 → x + y = word.or x y := sorry'

theorem xor_is_or (x y) : word.and x y = 0 → word.xor x y = word.or x y := sorry'

theorem add_is_xor (x y) : word.and x y = 0 → x + y = word.xor x y := sorry'

theorem add_and (x y z) : word.and y z = 0 →
  word.and x y + word.and x z = word.and x (word.or y z) := sorry'

/- ** Properties of shifts -/

@[simp] lemma bits_shl (x y i) : i < wordsize → test_bit (shl x y) i =
  if i < unsigned y then ff else test_bit x (i - unsigned y) := sorry'

@[simp] lemma bits_shru (x y i) : i < wordsize → test_bit (shru x y) i =
  if i + unsigned y < wordsize then test_bit x (i + unsigned y) else ff := sorry'

@[simp] lemma bits_shr (x y i) : i < wordsize → test_bit (shr x y) i =
  test_bit x (if i + unsigned y < wordsize then i + unsigned y else wordsize - 1) := sorry'

@[simp] theorem shl_zero (x) : shl x 0 = x := sorry'

lemma bitwise_binop_shl {f : word → word → word} {f' : bool → bool → bool} :
  (∀ x y i, i < wordsize → test_bit (f x y) i = f' (test_bit x i) (test_bit y i)) →
  f' ff ff = ff →
  ∀ x y n, f (shl x n) (shl y n) = shl (f x y) n := sorry'

theorem and_shl : ∀ x y n, word.and (shl x n) (shl y n) = shl (word.and x y) n :=
bitwise_binop_shl bits_and rfl

theorem or_shl : ∀ x y n, word.or (shl x n) (shl y n) = shl (word.or x y) n :=
bitwise_binop_shl bits_or rfl

theorem xor_shl : ∀ x y n, word.xor (shl x n) (shl y n) = shl (word.xor x y) n :=
bitwise_binop_shl bits_xor rfl

lemma ltu_inv (x y) : ltu x y → unsigned x < unsigned y := id

lemma ltu_iwordsize_inv (x) : ltu x iwordsize → unsigned x < wordsize := sorry'

theorem shl_shl (x y z) : ltu y iwordsize → ltu z iwordsize →
  ltu (y + z) iwordsize → shl (shl x y) z = shl x (y + z) := sorry'

theorem shru_zero (x) : shru x 0 = x := sorry'

lemma bitwise_binop_shru {f : word → word → word} {f' : bool → bool → bool} :
  (∀ x y i, i < wordsize → test_bit (f x y) i = f' (test_bit x i) (test_bit y i)) →
  f' ff ff = ff →
  ∀ x y n, f (shru x n) (shru y n) = shru (f x y) n := sorry'

theorem and_shru : ∀ x y n, word.and (shru x n) (shru y n) = shru (word.and x y) n :=
bitwise_binop_shru bits_and rfl

theorem or_shru : ∀ x y n, word.or (shru x n) (shru y n) = shru (word.or x y) n :=
bitwise_binop_shru bits_or rfl

theorem xor_shru : ∀ x y n, word.xor (shru x n) (shru y n) = shru (word.xor x y) n :=
bitwise_binop_shru bits_xor rfl

theorem shru_shru (x y z) : ltu y iwordsize → ltu z iwordsize →
  ltu (y + z) iwordsize → shru (shru x y) z = shru x (y + z) := sorry'

theorem shr_zero (x) : shr x 0 = x := sorry'

lemma bitwise_binop_shr {f : word → word → word} {f' : bool → bool → bool} :
  (∀ x y i, i < wordsize → test_bit (f x y) i = f' (test_bit x i) (test_bit y i)) →
  ∀ x y n, f (shr x n) (shr y n) = shr (f x y) n := sorry'

theorem and_shr : ∀ x y n, word.and (shr x n) (shr y n) = shr (word.and x y) n :=
bitwise_binop_shr bits_and

theorem or_shr : ∀ x y n, word.or (shr x n) (shr y n) = shr (word.or x y) n :=
bitwise_binop_shr bits_or

theorem xor_shr : ∀ x y n, word.xor (shr x n) (shr y n) = shr (word.xor x y) n :=
bitwise_binop_shr bits_xor

theorem shr_shr (x y z) : ltu y iwordsize → ltu z iwordsize →
  ltu (y + z) iwordsize → shr (shr x y) z = shr x (y + z) := sorry'

theorem and_shr_shru (x y z) : word.and (shr x z) (shru y z) = shru (word.and x y) z := sorry'

theorem shr_and_shru_and (x y z) : shru (shl z y) y = z →
  word.and (shr x y) z = word.and (shru x y) z := sorry'

theorem shru_lt_zero (x) : shru x (repr (wordsize - 1)) = to_bool (x < 0) := sorry'

theorem shr_lt_zero (x) : shr x (repr (wordsize - 1)) = -to_bool (x < 0) := sorry'

/- ** Properties of rotations -/

@[simp] lemma bits_rol (x y i) : i < wordsize →
  test_bit (rol x y) i = test_bit x ((i - unsigned y) % wordsize) := sorry'

@[simp] lemma bits_ror (x y i) : i < wordsize →
  test_bit (ror x y) i = test_bit x ((i + unsigned y) % wordsize) := sorry'

theorem shl_rolm (x n) : ltu n iwordsize → shl x n = rolm x n (shl (-1) n) := sorry'

theorem shru_rolm (x n) : ltu n iwordsize →
  shru x n = rolm x (iwordsize - n) (shru (-1) n) := sorry'

theorem rol_zero (x) : rol x 0 = x := sorry'

lemma bitwise_binop_rol {f : word → word → word} {f' : bool → bool → bool} :
  (∀ x y i, i < wordsize → test_bit (f x y) i = f' (test_bit x i) (test_bit y i)) →
  ∀ x y n, rol (f x y) n = f (rol x n) (rol y n) := sorry'

theorem rol_and : ∀ x y n, rol (word.and x y) n = word.and (rol x n) (rol y n) :=
bitwise_binop_rol bits_and

theorem rol_or : ∀ x y n, rol (word.or x y) n = word.or (rol x n) (rol y n) :=
bitwise_binop_rol bits_or

theorem rol_xor : ∀ x y n, rol (word.xor x y) n = word.xor (rol x n) (rol y n) :=
bitwise_binop_rol bits_xor

theorem rol_rol (x n m) : wordsize ∣ modulus →
  rol (rol x n) m = rol x (modu (n + m) iwordsize) := sorry'

theorem rolm_zero (x m) : rolm x 0 m = word.and x m := sorry'

theorem rolm_rolm (x n₁ m₁ n₂ m₂) : wordsize ∣ modulus →
  rolm (rolm x n₁ m₁) n₂ m₂ =
  rolm x (modu (n₁ + n₂) iwordsize) (word.and (rol m₁ n₂) m₂) := sorry'

theorem or_rolm (x n m₁ m₂) : word.or (rolm x n m₁) (rolm x n m₂) = rolm x n (word.or m₁ m₂) := sorry'

theorem ror_rol (x y) : ltu y iwordsize → ror x y = rol x (iwordsize - y) := sorry'

theorem ror_rol_neg (x y) : wordsize ∣ modulus → ror x y = rol x (-y) := sorry'

theorem or_ror (x y z) : ltu y iwordsize → ltu z iwordsize →
  y + z = iwordsize → ror x z = word.or (shl x y) (shru x z) := sorry'

/- ** Properties of [Z_one_bits] and [is_power2]. -/

lemma is_power2_rng (n logn) : is_power2 n = some logn → unsigned logn < wordsize :=
sorry'

theorem is_power2_range (n logn) : is_power2 n = some logn → ltu logn iwordsize :=
sorry'

lemma is_power2_correct (n logn) : is_power2 n = some logn →
  unsigned n = 2^unsigned logn := sorry'

theorem two_p_range (n) : n < wordsize → 2^n ≤ max_unsigned := sorry'

lemma is_power2_two_p (n) : n < wordsize → is_power2 (repr (2^n)) = some (repr n) := sorry'

/- ** Relation between bitwise operations and multiplications / divisions by powers of 2 -/

/- Left shifts and multiplications by powers of 2. -/

lemma Zshiftl_mul_two_p (x) (n : ℕ) : int.shiftl x n = x * 2^n := sorry'

lemma shl_mul_two_p (x y) : shl x y = x * repr (2 ^ unsigned y) := sorry'

theorem shl_mul (x y) : shl x y = x * shl 1 y := sorry'

theorem mul_pow2 (x n logn) : is_power2 n = some logn → x * n = shl x logn := sorry'

theorem shifted_or_is_add (x y n) : n < wordsize → unsigned y < 2^n →
  word.or (shl x (repr n)) y = repr (unsigned x * 2^n + unsigned y) := sorry'

/- Unsigned right shifts and unsigned divisions by powers of 2. -/

lemma shru_div_two_p (x y) :
  shru x y = repr (unsigned x / 2^unsigned y) := sorry'

theorem divu_pow2 (x n logn) : is_power2 n = some logn → divu x n = shru x logn := sorry'

/- Signed right shifts and signed divisions by powers of 2. -/

lemma shr_div_two_p (x y) : shr x y = repr (signed x / 2^unsigned y) := sorry'

theorem divs_pow2 (x n logn) : is_power2 n = some logn → x / n = shrx x logn := sorry'

/- Unsigned modulus over [2^n] is masking with [2^n-1]. -/

theorem modu_and (x n logn) : is_power2 n = some logn → modu x n = word.and x (n - 1) := sorry'

/- ** Properties of [shrx] (signed division by a power of 2) -/

lemma int.quot_div (x y) : y > 0 →
  int.quot x y = if x < 0 then (x + y - 1) / y else x / y := sorry'

theorem shrx_shr (x y) : ltu y (repr (wordsize - 1)) →
  shrx x y = shr (if x < 0 then x + (shl 1 y - 1) else x) y := sorry'

theorem shrx_shr_2 (x y) : ltu y (repr (wordsize - 1)) →
  shrx x y = shr (x + shru (shr x (repr (wordsize - 1))) (iwordsize - y)) y := sorry'

lemma Zdiv_shift (x y) : y > 0 →
  (x + (y - 1)) / y = x / y + if x % y = 0 then 0 else 1 := sorry'

theorem shrx_carry (x y) : ltu y (repr (wordsize - 1)) →
  shrx x y = shr x y + shr_carry x y := sorry'

/- Connections between [shr] and [shru]. -/

lemma shr_shru_positive (x y) : signed x ≥ 0 → shr x y = shru x y := sorry'

lemma and_positive (x y) : signed y ≥ 0 → signed (word.and x y) ≥ 0 := sorry'

theorem shr_and_is_shru_and (x y z) : y ≥ 0 →
  shr (word.and x y) z = shru (word.and x y) z := sorry'

@[simp] lemma bits_zero_ext (n x i) :
  test_bit (zero_ext n x) i = to_bool (i < n) && test_bit x i := sorry'

@[simp] lemma bits_sign_ext (n x i) : i < wordsize →
  test_bit (sign_ext n x) i = test_bit x (if i < n then i else n - 1) := sorry'

theorem zero_ext_above (n x) : n ≥ wordsize → zero_ext n x = x := sorry'

theorem sign_ext_above (n : ℕ+) (x) : n.1 ≥ wordsize → sign_ext n x = x := sorry'

theorem zero_ext_and (n x) : zero_ext n x = word.and x (repr (2^n - 1)) := sorry'

theorem zero_ext_mod (n x) : n < wordsize →
  unsigned (zero_ext n x) = unsigned x % 2^n := sorry'

theorem zero_ext_widen (x n n') : n ≤ n' →
  zero_ext n' (zero_ext n x) = zero_ext n x := sorry'

theorem sign_ext_widen (x) (n n' : ℕ+) : n.1 ≤ n'.1 →
  sign_ext n' (sign_ext n x) = sign_ext n x := sorry'

theorem sign_zero_ext_widen (x n) (n' : ℕ+) : n < n'.1 →
  sign_ext n' (zero_ext n x) = zero_ext n x := sorry'

theorem zero_ext_narrow (x n n') : n ≤ n' →
  zero_ext n (zero_ext n' x) = zero_ext n x := sorry'

theorem sign_ext_narrow (x) (n n' : ℕ+) : n.1 ≤ n'.1 →
  sign_ext n (sign_ext n' x) = sign_ext n x := sorry'

theorem zero_sign_ext_narrow (x n) (n' : ℕ+) : n ≤ n'.1 →
  zero_ext n (sign_ext n' x) = zero_ext n x := sorry'

theorem zero_ext_self (n x) : zero_ext n (zero_ext n x) = zero_ext n x := sorry'

theorem sign_ext_self (n x) : sign_ext n (sign_ext n x) = sign_ext n x := sorry'

theorem sign_ext_zero_ext (x n) : sign_ext n (zero_ext n x) = sign_ext n x := sorry'

theorem zero_ext_sign_ext (x) (n : ℕ+) : zero_ext n (sign_ext n x) = zero_ext n x := sorry'

theorem sign_ext_equal_if_zero_equal (n : ℕ+) (x y) :
  zero_ext n x = zero_ext n y → sign_ext n x = sign_ext n y := sorry'

theorem zero_ext_shru_shl (n x) : 0 < n → n < wordsize →
  let y := repr (wordsize - n) in
  zero_ext n x = shru (shl x y) y := sorry'

theorem sign_ext_shr_shl (n : ℕ+) (x) : n.1 < wordsize →
  let y := repr (wordsize - n) in
  sign_ext n x = shr (shl x y) y := sorry'

/- [zero_ext n x] is the unique integer congruent to [x] modulo [2^n]
    in the range [0...2^n-1]. -/

lemma zero_ext_range (n x) : n < wordsize → unsigned (zero_ext n x) < 2^n := sorry'

lemma eqmod_zero_ext (n x) : n < wordsize →
  unsigned (zero_ext n x) = unsigned x % 2^n := sorry'

/- [sign_ext n x] is the unique integer congruent to [x] modulo [2^n]
    in the range [-2^(n-1)...2^(n-1) - 1]. -/

lemma sign_ext_range (x) (n : ℕ+) : n.1 < wordsize →
  -(2^(n-1) : ℤ) ≤ signed (sign_ext n x) ∧ signed (sign_ext n x) < 2^(n-1) := sorry'

lemma eqmod_sign_ext' (x) (n : ℕ+) : n.1 < wordsize →
  unsigned (sign_ext n x) % 2^n = unsigned x % 2^n := sorry'

lemma eqmod_sign_ext (x) (n : ℕ+) : n.1 < wordsize →
  signed (sign_ext n x) % 2^n = unsigned x % 2^n := sorry'

/- ** Properties of [one_bits] (decomposition in sum of powers of two) -/

theorem one_bits_range (x i) : i ∈ one_bits x → ltu i iwordsize := sorry'

def int_of_one_bits : list word → word
| [] := 0
| (a :: l) := shl 1 a + int_of_one_bits l

theorem one_bits_decomp (x) : int_of_one_bits (one_bits x) = x := sorry'

/- ** Properties of comparisons -/

theorem negate_cmp (c x y) : cmp (negate_comparison c) x y = bnot (cmp c x y) := sorry'

theorem negate_cmpu (c x y) : cmpu (negate_comparison c) x y = bnot (cmpu c x y) := sorry'

theorem swap_cmp (c x y) : cmp (swap_comparison c) x y = cmp c y x := sorry'

theorem swap_cmpu (c x y) : cmpu (swap_comparison c) x y = cmpu c y x := sorry'

lemma translate_ltu (x y d) :
  unsigned x + unsigned d ≤ max_unsigned →
  unsigned y + unsigned d ≤ max_unsigned →
  ltu (x + d) (y + d) ↔ ltu x y := sorry'

theorem translate_cmpu (c x y d) :
  unsigned x + unsigned d ≤ max_unsigned →
  unsigned y + unsigned d ≤ max_unsigned →
  cmpu c (x + d) (y + d) = cmpu c x y := sorry'

lemma translate_lt (x y d) :
  in_srange (signed x + signed d) →
  in_srange (signed y + signed d) →
  x + d < y + d ↔ x < y := sorry'

theorem translate_cmp (c x y d) :
  in_srange (signed x + signed d) →
  in_srange (signed y + signed d) →
  cmp c (x + d) (y + d) = cmp c x y := sorry'

theorem notbool_isfalse_istrue (x) : is_false x → is_true (notbool x) := sorry'

theorem notbool_istrue_isfalse (x) : is_true x → is_false (notbool x) := sorry'

theorem ltu_range_test (x y) : ltu x y → unsigned y ≤ max_signed →
  0 ≤ signed x ∧ signed x < unsigned y := sorry'

theorem lt_sub_overflow (x y) :
  word.xor (sub_overflow x y 0) (negative (x - y)) = to_bool (x < y) := sorry'

lemma signed_eq {x y} : x = y ↔ signed x = signed y := sorry'

lemma unsigned_eq {x y} : x = y ↔ unsigned x = unsigned y := sorry'

lemma leu_iff_ltu_or_eq (x y : word) : leu x y ↔ ltu x y ∨ x = y :=
iff.trans (@le_iff_lt_or_eq ℕ _ _ _) (or_congr iff.rfl unsigned_eq.symm)

lemma le_iff_lt_or_eq (x y : word) : x ≤ y ↔ x < y ∨ x = y :=
iff.trans (@le_iff_lt_or_eq ℤ _ _ _) (or_congr iff.rfl signed_eq.symm)

instance decidable_linear_order : decidable_linear_order word :=
{ le              := (≤),
  le_refl         := λx, @le_refl ℤ _ _,
  le_trans        := λx y z, @le_trans ℤ _ _ _ _,
  le_antisymm     := λx y h1 h2, signed_eq.2 $ le_antisymm h1 h2,
  lt              := (<),
  le_iff_lt_or_eq := le_iff_lt_or_eq,
  lt_irrefl       := λx, @lt_irrefl ℤ _ _,
  le_total        := λx y, @le_total ℤ _ _ _,
  decidable_lt    := by apply_instance,
  decidable_le    := by apply_instance,
  decidable_eq    := by apply_instance }

lemma ltu_not (x y) : ltu y x ↔ ¬ltu x y ∧ x ≠ y := sorry'

/- Non-overlapping test -/

def no_overlap (ofs1 : word) (sz1 : ℕ) (ofs2 : word) (sz2 : ℕ) : bool :=
let x1 := unsigned ofs1, x2 := unsigned ofs2 in
x1 + sz1 < modulus ∧ x2 + sz2 < modulus ∧ (x1 + sz1 ≤ x2 ∨ x2 + sz2 ≤ x1)

instance (ofs1 sz1 ofs2 sz2) : decidable (no_overlap ofs1 sz1 ofs2 sz2) :=
by apply_instance

lemma no_overlap_sound (ofs1 sz1 ofs2 sz2 base) :
  sz1 > 0 → sz2 > 0 → no_overlap ofs1 sz1 ofs2 sz2 →
  unsigned (base + ofs1) + sz1 ≤ unsigned (base + ofs2)
  ∨ unsigned (base + ofs2) + sz2 ≤ unsigned (base + ofs1) := sorry'

/- Size of integers, in bits. -/

def size (x : word) : ℕ := nat.size (unsigned x)

set_option type_context.unfold_lemmas true
theorem size_zero : size 0 = 0 := congr_arg nat.size unsigned_zero

theorem test_bit_size (x) : x > 0 → test_bit x (size x - 1) := sorry'

theorem test_bit_size_lt (x i) : test_bit x i → i < size x := sorry'

theorem size_le_wordsize (x) : size x ≤ wordsize := sorry'

theorem bits_size_le (x n) (h : ∀ i < wordsize, test_bit x i → i < n) : size x ≤ n := sorry'

theorem bits_size_eq (x n) : test_bit x (n - 1) →
  (∀ i < wordsize, test_bit x i → i < n) → size x = n := sorry'

theorem lt_pow_size (x) : unsigned x < 2^size x := nat.lt_pow_size _

theorem size_le_of_lt_pow (x n) : unsigned x < 2^n → size x ≤ n := nat.size_le_of_lt_pow

theorem size_and (a b) : size (word.and a b) ≤ min (size a) (size b) := sorry'

theorem and_interval (a b) : unsigned (word.and a b) < 2^ min (size a) (size b) := sorry'

theorem size_or (a b) : size (word.or a b) = max (size a) (size b) := sorry'

theorem or_interval (a b) : unsigned (word.or a b) < 2^ max (size a) (size b) := sorry'

theorem size_xor (a b) : size (word.xor a b) ≤ max (size a) (size b) := sorry'

theorem xor_interval (a b) : unsigned (word.xor a b) < 2^ max (size a) (size b) := sorry'

theorem wordsize_dvd_modulus (n) : wordsize = 2^n → wordsize ∣ modulus := sorry'

@[simp] lemma length_words_of_int (n x) : (words_of_int n x).length = n :=
by revert x; induction n; simph [words_of_int]

@[simp] lemma nat_of_words_of_int (n x) :
  nat_of_words (words_of_int n x) = x.nat_mod (2^(wordsize * n)) := sorry'

lemma words_of_int_mod (n) {x y : ℤ} :
  x.nat_mod (2^(wordsize * n)) = y.nat_mod (2^(wordsize * n)) →
  words_of_int n x = words_of_int n y :=
sorry'

lemma nat_of_words_append (l2 l1) :
  nat_of_words (l1 ++ l2) = nat_of_words l1 + nat_of_words l2 * 2^(wordsize * l1.length) := sorry'

lemma nat_of_words_range (l) : nat_of_words l < 2^(wordsize * l.length) := sorry'

lemma words_of_int_append {n2 x2 n1 x1} : x1 < 2^(wordsize * n1) →
  words_of_int (n1 + n2) (x1 + x2 * 2^(wordsize * n1)) =
  words_of_int n1 x1 ++ words_of_int n2 x2 := sorry'

/- Theorems that depend on positive word size -/
parameter {wordsize_pos : wordsize > 0}

theorem unsigned_one : unsigned 1 = 1 := sorry'

theorem one_ne_zero : (1:word) ≠ 0 := sorry'

theorem succ_leu_of_ltu {x y} (h : ltu x y) : leu (x + 1) y :=
begin
  change unsigned (repr (unsigned x + unsigned 1)) ≤ unsigned y,
  rw [unsigned_one, -int.coe_nat_add, word.unsigned_repr],
  exact h,
  exact nat.lt_of_lt_of_le h (unsigned_range_2 _),
end

theorem leu_pred_of_ltu {x y} (h : ltu x y) : leu x (y - 1) :=
begin
  change unsigned x ≤ unsigned (y - 1),
  rw [sub_unsigned, unsigned_one, -int.coe_nat_sub, unsigned_repr],
  exact nat.pred_le_pred h,
  exact le_trans (nat.sub_le _ _) (unsigned_range_2 _),
  exact lt_of_le_of_lt (nat.zero_le _) h
end

/- ** Properties of [modulus], [max_unsigned], etc. -/

theorem half_modulus_modulus : modulus = 2 * half_modulus := sorry'

end

def scoe {w w' : ℕ} (x : word w) : word w' := repr (signed x)
def ucoe {w w' : ℕ} (x : word w) : word w' := repr (unsigned x)

end word

def uword (n) := word n

namespace uword
open word
section
parameter {w : ℕ+}
local notation `uword` := uword w

instance coe_uword_nat : has_coe uword ℕ := ⟨unsigned⟩
instance : has_zero uword := ⟨repr 0⟩
instance : has_one uword := ⟨repr 1⟩

instance eq_dec : decidable_eq uword := word.eq_dec

instance : has_lt uword := ⟨ltu⟩
instance : has_le uword := ⟨leu⟩

instance : has_neg uword := ⟨word.neg⟩
instance : has_add uword := ⟨word.add⟩
instance : has_mul uword := ⟨word.mul⟩

instance : has_div uword := ⟨divu⟩
instance : has_mod uword := ⟨modu⟩

instance decidable_lt : @decidable_rel uword (<) := by apply_instance
instance decidable_le : @decidable_rel uword (≤) := by apply_instance

instance comm_ring : comm_ring uword := word.comm_ring
instance decidable_linear_order : decidable_linear_order uword :=
{ le              := (≤),
  le_refl         := λx, @le_refl ℕ _ _,
  le_trans        := λx y z, @le_trans ℕ _ _ _ _,
  le_antisymm     := λx y h1 h2, unsigned_eq.2 $ le_antisymm h1 h2,
  lt              := (<),
  le_iff_lt_or_eq := leu_iff_ltu_or_eq,
  lt_irrefl       := λx, @lt_irrefl ℕ _ _,
  le_total        := λx y, @le_total ℕ _ _ _,
  decidable_lt    := by apply_instance,
  decidable_le    := by apply_instance,
  decidable_eq    := by apply_instance }

theorem succ_le_of_lt {x y : uword} : x < y → x + 1 ≤ y := word.succ_leu_of_ltu

theorem le_pred_of_lt {x y : uword} : x < y → x ≤ y - 1 := word.leu_pred_of_ltu

theorem zero_le (x : uword) : 0 ≤ x :=
show unsigned 0 ≤ _, by rw unsigned_zero; apply nat.zero_le

end
end uword


import algebra.char_p.basic
import ring_theory.localization
import algebra.free_algebra
import algebra.char_p.algebra

-- namespace char_p

-- lemma ring_char_of_prime_eq_zero {R : Type*} [non_assoc_semiring R]
--   [nontrivial R] {p : ℕ}
--   (hprime : nat.prime p) (hp0 : (p : R) = 0) : ring_char R = p :=
-- or.resolve_left ((nat.dvd_prime hprime).1 (ring_char.dvd hp0)) ring_char_ne_one

-- end char_p

namespace ring_char

lemma lt_char {A : Type*} [non_assoc_semiring A]
  {n : ℕ} : (n : A) = 0 → n < ring_char A → n = 0 :=
begin
  rw spec A n,
  exact nat.eq_zero_of_dvd_of_lt,
end

lemma lt_char_field {A : Type*} [field A]
  {n : ℕ} : (n : A) = 0 → n < ring_char A → n = 0 :=
begin
  rw spec A n,
  exact nat.eq_zero_of_dvd_of_lt,
end

end ring_char