import heap.lemmas misc
import tactic.monotonicity
import tactic.library_search
import logic.basic

namespace separation

open memory finmap

variables value : Type

def hProp := heap value → Prop

variables {value}
include value
local notation `heap` := heap value
local notation `hProp` := hProp value
local notation `tptr` := tptr value

namespace «hProp»

@[extensionality]
lemma hProp.ext {p q : hProp} (H : ∀ h, p h ↔ q h) : p = q :=
by ext; apply H

def emp : hProp := λ h, h = ∅

def and (x y : hProp) : hProp
| h := ∃ h₀ h₁, some h = add (some h₀) (some h₁) ∧ x h₀ ∧ y h₁

def lift (p : Prop) : hProp
| h := p ∧ emp h

notation `[| ` p ` |]` := lift p

lemma lift_eq_emp {p} (h : p) : [| p |] = @emp value :=
by { funext h', ext, simp [lift,h] }

infixr ` ⊛ `:55 := and

@[simp]
lemma emp_and (p : hProp) : emp ⊛ p = p :=
begin
  ext; simp [emp,and,(∈),set.mem,add]; split,
  { simp, introv h₀ h₁, subst h₁,
    simp [disjoint_empty,pure] at h₀, subst h₀, exact id },
  { intro hp, existsi [(∅ : finmap _),h],
    rw [if_pos (disjoint_empty h)], simp,
    exact ⟨rfl, hp⟩ }
end

lemma and_comm (p q : hProp) : p ⊛ q = q ⊛ p :=
funext $ λ h, by { dsimp [and], rw exists_swap, ext, repeat { apply exists_congr; intro },
                   rw [memory.add_comm,and_comm (p a_1)] }

instance and.is_commutative : is_commutative _ (@and value) := ⟨ and_comm ⟩

@[simp]
lemma and_emp (p : hProp) : p ⊛ emp = p :=
by rw [and_comm,emp_and]

def And {α} (p : α → hProp) : list α → hProp
| [] := emp
| (x :: xs) := p x ⊛ And xs

def p_exists {α} (p : α → hProp) : hProp
| h := ∃ x, p x h

notation `∃∃ ` binders `, ` r:(scoped P, p_exists P) := r

def p_forall {α} (p : α → hProp) : hProp
| h := ∀ x, p x h

notation `∀∀ ` binders `, ` r:(scoped P, p_forall P) := r

def maplets : ptr → value → hProp
-- | p [] := emp
| p v h := h = maplet p v

infix ` ↦ `:60 := maplets

open list

lemma and_assoc (p q r : hProp) : (p ⊛ q) ⊛ r = p ⊛ q ⊛ r :=
begin
  ext : 1; dsimp [and,(∈),set.mem],
  split,
  { rintros ⟨h₀,h₁,Hx,⟨h₂,h₃,HH,Hp,Hq⟩,Hr⟩,
    have : disjoint h₃ h₁,
    { by_contradiction,
      rw [HH,memory.add_assoc] at Hx, simp [add,if_neg,a] at Hx,
      exact Hx },
    refine ⟨_, h₃ ∪ h₁, _, Hp, _, _, _, Hq, Hr⟩,
    { rw [Hx,HH,memory.add_assoc,union_eq_add_of_disjoint this] },
    { rw union_eq_add_of_disjoint this } },
  { rintro ⟨h₀,h₁,Hx,Hp,h₂,h₃,Hh₁,Hq,Hr⟩,
    have : disjoint h₀ h₂,
    { by_contradiction,
      rw [Hh₁,← memory.add_assoc] at Hx, simp [add,if_neg,a] at Hx,
      exact Hx },
    refine ⟨h₀ ∪ h₂,_,_,⟨_,_,_,Hp,Hq⟩,Hr⟩,
    { rw [Hx,Hh₁,union_eq_add_of_disjoint this,memory.add_assoc] },
    { rw union_eq_add_of_disjoint this } }
end

instance and.is_associative : is_associative _ (@and value) := ⟨ hProp.and_assoc ⟩

@[simp, separation_logic]
lemma And_append {α} (p : α → hProp) (xs ys : list α) : And p (xs ++ ys) = And p xs ⊛ And p ys :=
by induction xs; dsimp [And]; [rw emp_and, rw [xs_ih,and_assoc]]

@[simp]
lemma And_map {α β} (p : α → hProp) (f : β → α) : Π (xs : list β), And p (map f xs) = And (p ∘ f) xs
| [] := rfl
| (x :: xs) := by rw [map,And,And,And_map]

open nat

-- lemma maplets_eq_And (p : ptr) (vs : list value) : (p ↦ vs) = And (λ i, p+i ↦ nth' i vs) (range vs.length) :=
-- begin
--   induction vs generalizing p,  refl,
--   simp [maplets], simp only [nat.add_comm 1,range_succ_eq_map,And,vs_ih,And_map,(∘),nth'],
--   congr' 1, ext, simp [maplets], simp [succ_eq_add_one]
-- end

def holds (h frame : heap) (p : hProp) : Prop :=
∃ h₀, some h = some h₀ ⊗ some frame ∧ p h₀

def holds' (h : heap) (p : hProp) : Prop :=
∃ h', holds h h' p

infix ` ⊨ `:60 := holds'

lemma holds_union_and {h h' frame : heap} {p q : hProp}
  (H₀ : holds h frame p) (H₁ : q h') (H₂ : disjoint h h') :
  holds (h ∪ h') frame (p ⊛ q) :=
begin
  simp [holds,and] at H₀ ⊢,
  rcases H₀ with ⟨h'', H₀, H₃⟩,
  existsi h' ∪ h'', rw [union_eq_add_of_disjoint H₂,union_eq_add_of_disjoint,H₀],
  split, ac_refl,
  refine ⟨_,_,add_comm _ _,H₃,H₁⟩,
  symmetry, apply disjoint_mono _ (le_refl h') H₂,
  apply le_of_add_eq_some _ H₀,
end

lemma holds_of_holds_union_and {h h' frame : heap} {p q : hProp}
  (H₀ : holds (h ∪ h') frame (p ⊛ q)) (H₁ : q h') (H₂ : disjoint h h') (H₃ : ∀ h'', q h'' → h'' = h') :
  holds h frame p :=
begin
  simp [holds,and] at H₀ ⊢,
  rcases H₀ with ⟨h'', H₀, h₀, h₁, H₆, H₄, H₅⟩,
  refine ⟨h₀,_,H₄⟩,
  rw [union_eq_add_of_disjoint H₂,H₆] at H₀,
  replace H₃ := H₃ _ H₅, subst h',
  have := union_eq_add_of_disjoint H₂,
  apply add_inj (some h₁) (h ∪ h₁)  (h ∪ h₁) this,
  rw [this,H₀], ac_refl, rw H₀, ac_refl,
end

lemma holds_of_holds_union_iff {h h' frame : heap} {p q : hProp}
  (H₁ : q h') (H₂ : disjoint h h') (H₃ : ∀ h'', q h'' → h'' = h') :
  holds (h ∪ h') frame (p ⊛ q) ↔ holds h frame p :=
⟨ λ H₀, holds_of_holds_union_and H₀ H₁ H₂ H₃, λ H₀,holds_union_and H₀ H₁ H₂ ⟩

lemma holds_of_holds_and (h h₀ : heap) {p q : hProp} :
  holds h h₀ (p ⊛ q) ↔ (∃ h₁, holds h₁ h₀ q ∧ holds h h₁ p) :=
begin
  split; simp only [holds, and, and_imp, exists_imp_distrib],
  { introv hh hx hp hq,
    rw hx at hh, clear hx,
    have hh : ∃ k, some k = some x_2 ⊗ some h₀,
    { apply add_eq_some _ (some x_1) h,
      rw [memory.add_comm,← memory.add_assoc,hh] },
    cases hh with k hk,
    existsi k, split,
    exact ⟨_,hk,hq⟩,
    refine ⟨_,_,hp⟩, rw [hk,hh,memory.add_assoc] },
  { introv hh hx hh' hp,
    rw hh at hh', clear hh,
    have hh : ∃ k, some k = some x_2 ⊗ some x_1,
    { apply add_eq_some _ (some h₀) h,
      rw [memory.add_assoc,hh'] },
    cases hh with k hk,
    existsi k, rw [hk,memory.add_assoc],
    existsi hh',
    refine ⟨_,_,rfl,hp,hx⟩ }
end

-- @[simp]
-- lemma maplets_nil (p : ptr) : (p ↦ nil) = @emp value := rfl

-- @[separation_logic]
-- lemma maplets_cons (p : ptr) (v : value) (vs : list value) : (p ↦ v :: vs) = (p ↦ [v]) ⊛ (p+1 ↦ vs) :=
-- by dsimp [maplets]; rw and_emp

structure impl (p q : hProp) : Prop :=
intro ::
(elim : ∀ h, p h → q h)

infixr ` =*> `:40 := impl

def wand (p q : hProp) : hProp
| h := ∀ h₀ h', some h' = some h₀ ⊗ some h → p h₀ → q h'

infixr ` ⊸ `:54 := wand

lemma and_wand {p q : hProp} : p ⊛ (p ⊸ q) =*> q :=
⟨ λ h ⟨h₀,h₁,Hh,Hp,Hpq⟩, Hpq h₀ _ Hh Hp ⟩

lemma disjoint_of_disjoint_union_left {h₀ h₁ : heap} (h₂ : heap) (H : disjoint h₀ (h₁ ∪ h₂)) :
  disjoint h₀ h₁ :=
λ x hx₀ hx₁, H x hx₀ (finmap.mem_union.mpr $ or.inl hx₁)

lemma disjoint_of_disjoint_union_right {h₀ h₁ : heap} (h₂ : heap) (H : disjoint (h₀ ∪ h₂) h₁) :
  disjoint h₀ h₁ :=
(disjoint_of_disjoint_union_left h₂ H.symm).symm

lemma wand_wand {p q r : hProp} : p ⊸ (q ⊸ r) = (p ⊛ q) ⊸ r :=
begin
  ext, simp only [wand, and, and_imp, exists_imp_distrib,@forall_swap (p _)],
  split; intros H h₀ h₁ Hhh₀ h₂ h₃ Hhh₂ Hp Hq,
  { have : some (h₂ ∪ h) = some h₂ ⊗ some h,
    { apply union_eq_add_of_disjoint, apply disjoint_of_disjoint_union_right h₃,
      apply disjoint_of_add h₁, rw union_eq_add_of_disjoint, cc,
      apply disjoint_of_add _ Hhh₂ },
    apply H _ (h₂ ∪ h) this _ _ _ Hp Hq, simp only *, cc },
  { have : some (h₀ ∪ h₂) = some h₀ ⊗ some h₂,
    { apply union_eq_add_of_disjoint, apply disjoint_of_disjoint_union_right h,
      apply disjoint_of_add h₃, rw union_eq_add_of_disjoint, cc,
      apply disjoint_of_add _ Hhh₀ },
    apply H (h₀ ∪ h₂) _ _ _ _ this Hp Hq, simp only *, cc },
end

lemma wand_deduction {p q r : hProp} : p =*> q ⊸ r ↔ p ⊛ q =*> r :=
by { split; rintro ⟨ H ⟩; constructor;
       [rintros h ⟨h₀,h₁,HH,Hp,hq⟩, intros h Hp h₀ h₁ HH Hq];
       apply H; try { assumption <|> refine ⟨h,h₀,_,Hp,Hq⟩ };
     rw [HH,memory.add_comm] }

@[refl]
lemma impl_refl (p : hProp) : p =*> p := impl.intro $ λ x, id

@[trans]
lemma impl_trans {p q r : hProp} (hpq : p =*> q) (hqr : q =*> r) : p =*> r :=
impl.intro $ λ h hp, hqr.elim _ (hpq.elim _ hp)

def True : hProp | h := true

def False : hProp | h := false

@[simp]
lemma impl_True {p : hProp} : p =*> True :=
⟨ λ _ _, trivial ⟩

@[simp, separation_logic]
lemma lift_false : [| false |] = @False value :=
funext $ λ h, by simp [lift,False]

@[simp, separation_logic]
lemma False_and (p : hProp) : False ⊛ p = False :=
by ext; simp [and,False]

@[simp, separation_logic]
lemma and_False (p : hProp) : p ⊛ False = False :=
by ext; simp [and,False]

-- @[simp]
lemma False_impl (p : hProp) : False =*> p :=
impl.intro $ λ _, false.elim

lemma holds_p_exists {α} {h h' : heap} (p : α → hProp) : holds h h' (p_exists p) ↔ ∃ x, holds h h' (p x) :=
by split; rintro ⟨_,H,H',H''⟩; [ exact ⟨_,a_w,H,H''⟩, exact ⟨H,H',_,H''⟩ ]

lemma and_p_exists_distrib_right {α} {p : α → hProp} {q : hProp} :
  p_exists p ⊛ q = ∃∃ x, p x ⊛ q :=
begin
  ext, dsimp [and,p_exists], split; simp,
  { intros h₀ h₁ H r Hp Hq, refine ⟨_,_,_,H,Hp,Hq⟩ },
  { intros r h₀ h₁ H Hp Hq,
    refine ⟨_,_,H,⟨_,Hp⟩,Hq⟩, }
end

lemma and_p_exists_distrib_left {α} {p : hProp} {q : α → hProp} :
  p ⊛ p_exists q = ∃∃ x, p ⊛ q x :=
by rw [and_comm, and_p_exists_distrib_right]; simp [and_comm]

def p_or (p q : hProp) : hProp
| h := p h ∨ q h

def p_and (p q : hProp) : hProp
| h := p h ∧ q h

infixr ` ⋁ `:53 := p_or

infixr ` ⋀ `:53 := p_and

lemma p_and_impl_p_and {p p' q q' : hProp} (hp : p =*> q) (hq : p' =*> q') :
  p ⋀ p' =*> q ⋀ q' :=
⟨ λ h, and.imp (hp.elim _) (hq.elim _) ⟩

lemma impl_and {p q q' : hProp} (H : p =*> q) (H' : p =*> q') :
  p =*> q ⋀ q' :=
⟨ λ h hp, ⟨H.elim _ hp,H'.elim _ hp⟩ ⟩

lemma impl_exists {α} {p : hProp} {q : α → hProp} (x : α) (hpq : p =*> q x) : p =*> p_exists q :=
impl.intro $ λ h hp, ⟨_,hpq.elim _ hp⟩

lemma exists_impl {α} {p : α → hProp} {q : hProp} (hpq : ∀ x, p x =*> q) : p_exists p =*> q :=
impl.intro $ λ h ⟨_, hp⟩, (hpq _).elim _ hp

lemma impl_antisymm {p q : hProp} (hpq : p =*> q) (hqp : q =*> p) : p = q :=
by ext; exact ⟨hpq.elim _,hqp.elim _⟩

open relation

lemma impl_of_eq {p q : hProp} (hpq : p = q) : p =*> q := impl.intro $ λ h, hpq.subst

lemma exists_impl_exists_of_total {α β} {p : α → hProp} {q : β → hProp}
  (R : α → β → Prop) (hl : left_total R)
  (hpq : ∀ x y, R x y → p x =*> q y) : p_exists p =*> p_exists q :=
exists_impl $ λ x, Exists.rec_on (hl x) $ λ w hw, impl_exists w (hpq _ _ hw)

lemma exists_congr_of_total {α β} {p : α → hProp} {q : β → hProp}
  (R : α → β → Prop) (hl : left_total R) (hr : right_total R)
  (hpq : ∀ x y, R x y → p x = q y) : p_exists p = p_exists q :=
impl_antisymm
  (exists_impl_exists_of_total R hl $ λ x y hR, impl_of_eq $ hpq _ _ hR)
  (exists_impl_exists_of_total (flip R) hr $ λ x y hR, impl_of_eq (hpq _ _ hR).symm)

lemma exists_impl_exists {α} {p q : α → hProp} (hpq : ∀ x, p x =*> q x) : p_exists p =*> p_exists q :=
exists_impl $ λ x, impl_exists x (hpq _)

lemma exists_impl_exists_to {α β} {p : α → hProp} {q : β → hProp}
  (f : α → β)
  (hpq : ∀ x, p x =*> q (f x)) : p_exists p =*> p_exists q :=
exists_impl $ λ x, impl_exists (f x) (hpq _)

open function

lemma exists_impl_exists_from {α β} {p : α → hProp} {q : β → hProp}
  (f : β → α) (hf : surjective f)
  (hpq : ∀ x, p (f x) =*> q x) : p_exists p =*> p_exists q :=
exists_impl $ λ x, Exists.rec_on (hf x) $ λ w hf, impl_exists w $ hf ▸ hpq w

lemma exists_congr' {α β} {p : α → hProp} {q : β → hProp}
  (f : α → β) (hf : surjective f)
  (hpq : ∀ x, p x = q (f x)) : p_exists p = p_exists q :=
impl_antisymm
  (exists_impl_exists_to f $ λ x, impl_of_eq $ hpq x)
  (exists_impl_exists_from f hf $ λ x, impl_of_eq (hpq x).symm)

lemma or_impl {p p' : hProp} {q : hProp}
  (H  : p  =*> q)
  (H' : p' =*> q) :
   p ⋁ p' =*> q :=
impl.intro $ λ h h', or.elim h' (H.elim h) (H'.elim h)

@[congr]
lemma exists_congr {α} {p q : α → hProp}
  (hpq : ∀ x, p x = q x) : p_exists p = p_exists q :=
congr_arg _ $ funext hpq

@[mono]
lemma and_impl_and {p p' q q' : hProp} (hpq : p =*> q) (hpq' : p' =*> q') : p ⊛ p' =*> q ⊛ q' :=
impl.intro $ λ h, exists_imp_exists $ λ h₀, exists_imp_exists $ λ h₁, and.imp_right $ and_implies (hpq.elim _) (hpq'.elim _)

lemma lift_impl_emp {p : Prop} : [|p|] =*> @emp value :=
⟨ λ h ⟨_,h'⟩, h' ⟩

@[mono]
lemma lift_impl_lift {p q : Prop} (h : p → q) : [|p|] =*> ([|q|] : hProp) :=
impl.intro $ λ hp, and.imp h id

lemma lift_p_and_and {p : Prop} {q : hProp} : [| p |] ⊛ q = [| p |] ⊛ True ⋀ q :=
impl_antisymm
  (impl_and (and_impl_and (impl_refl _) impl_True)
            (emp_and q ▸ and_impl_and lift_impl_emp ((emp_and q).symm ▸ impl_refl q)))
  ⟨λ h ⟨⟨h₀,h₁,h₂,h₃,h₄⟩,h'⟩,
     have h = h₁, by { dsimp [lift,emp] at h₃,
                       rw [h₃.2,empty_add,option.some.inj_eq] at h₂,
                       exact h₂ },
     ⟨h₀,h₁,h₂,h₃,this ▸ h'⟩⟩

lemma impl_or_left {p q q' : hProp} (hpq : p =*> q) : p =*> q ⋁ q' :=
impl.intro $ λ h hp, or.inl (hpq.elim h hp)

lemma impl_or_right {p q q' : hProp} (hpq : p =*> q') : p =*> q ⋁ q' :=
impl.intro $ λ h hp, or.inr (hpq.elim h hp)

lemma p_and_or_distrib_left {p q r : hProp} :
  p ⊛ (q ⋁ r) = (p ⊛ q) ⋁ (p ⊛ r) :=
impl_antisymm
  ⟨ λ h ⟨h₀,h₁,Hh,Hp,Hqr⟩,
        or.elim Hqr (λ Hq, or.inl ⟨h₀,h₁,Hh,Hp,Hq⟩)
                    (λ Hr, or.inr ⟨h₀,h₁,Hh,Hp,Hr⟩) ⟩
  (or_impl (and_impl_and (impl_refl _) (impl_or_left (impl_refl _)))
           (and_impl_and (impl_refl _) (impl_or_right (impl_refl _))) )

@[simp, separation_logic]
lemma lift_true : [| true |] = (emp : hProp) := lift_eq_emp trivial

lemma lift_and_iff_p_exists {p : Prop} {q : hProp} : [|p|] ⊛ q = ∃∃ h : p, q :=
begin
  ext, dsimp [and,p_exists,lift,emp], split,
  { rintros ⟨h₀,h₁,H₀,⟨H₁,H₂⟩,H₃⟩, subst H₂,
    rw [empty_add,option.some_inj] at H₀, exact ⟨H₁, H₀.symm ▸ H₃⟩ },
  { rintros ⟨hp,hq⟩, refine ⟨∅,h,_,⟨hp,rfl⟩,hq⟩,
    rw [empty_add,option.some_inj] }
end

@[simp]
lemma lift_and_applied {p : Prop} {q : hProp} (h : heap) : ([|p|] ⊛ q) h ↔ p ∧ q h :=
by simp [lift_and_iff_p_exists,p_exists]

lemma and_applied_union {p q : hProp} {h h' : heap} (Hp : p h) (Hq : q h') (Hdisj : disjoint h h') : (p ⊛ q) (h ∪ h') :=
⟨h, h', union_eq_add_of_disjoint Hdisj, Hp, Hq⟩

lemma lift_and_impl {p : Prop} {q r : hProp}
  (h : p → q =*> r) :
  [|p|] ⊛ q =*> r :=
suffices (∃∃ h : p, q) =*> r,
  by simpa [lift_and_iff_p_exists],
exists_impl h

lemma lift_impl {p : Prop} {r : hProp}
  (h : p → emp =*> r) :
  [|p|] =*> r :=
suffices [|p|] ⊛ emp =*> r,
  by simpa [and_emp],
lift_and_impl h

lemma impl_lift_and {p : Prop} {q r : hProp}
  (h : p)
  (h' : q =*> r) :
  q =*> [|p|] ⊛ r :=
suffices q =*> (∃∃ h : p, r),
  by simpa [lift_and_iff_p_exists],
impl_exists h h'

lemma holds_or_iff {h frame : heap} {p q : hProp} :
  holds h frame (p ⋁ q) ↔ holds h frame p ∨ holds h frame q :=
by { dsimp [holds,p_or], rw [← exists_or_distrib],
     simp [and_or_distrib_left] }

lemma holds_imp_holds_of_impl {h frame : heap} {p q : hProp}
  (Hpq : p =*> q) : holds h frame p → holds h frame q :=
exists_imp_exists (λ hp, and.imp_right $ Hpq.elim hp)

@[simp]
lemma holds_lift_and {h frame : heap} {p : Prop} {q : hProp} : holds h frame ([|p|] ⊛ q) ↔ p ∧ holds h frame q :=
begin
  simp [holds,lift,emp], rw ← exists_and_distrib_left,
  apply _root_.exists_congr, intro, cc,
end

@[simp]
lemma holds_lift {h frame : heap} {p : Prop} : holds h frame [|p|] ↔ p ∧ holds h frame emp :=
by rw [← holds_lift_and,and_emp]

lemma exists_subtype {α} {p : α → Prop} {q : α → hProp} :
  (∃∃ x : subtype p, q x.val) = (∃∃ x : α, [| p x |] ⊛ q x) :=
impl_antisymm
  (exists_impl_exists_to subtype.val (by simp; intros a ha; simp [lift_eq_emp ha]))
  (exists_impl $ λ x, lift_and_impl $ λ hp, impl_exists ⟨_,hp⟩ $ impl_refl _)

lemma exists_exists {α} {p : α → Sort*} {q : Π x, p x → hProp} :
  (∃∃ (x : α) (h : p x), q x h) = (∃∃ x : psigma p, q x.1 x.2) :=
impl_antisymm
  (exists_impl $ λ x, exists_impl $ λ h, impl_exists ⟨x,h⟩ $ impl_refl _)
  (exists_impl $ λ x, impl_exists x.1 $ impl_exists x.2 $ impl_refl _)

end «hProp»

variable (value)
class storable (α : Type*) :=
(size : α → ℕ)
(repr : tptr α → α → hProp)

export storable (size)

local notation `storable` := storable value

section

omit value
meta def check_fixed_size : tactic unit := `[intros; refl]

end

-- def typeof {α} (x : α) := α
-- #check storable.repr
infix ` ⤇ `:60 := storable.repr

class fixed_storable (α : Type*) extends storable α :=
(fixed_size : ℕ)
(is_fixed : ∀ x : α, size x = fixed_size . check_fixed_size)
(size := λ _, fixed_size)
(pos_size : fixed_size > 0)

open list function «hProp»

export fixed_storable (fixed_size)

local notation `fixed_storable` := fixed_storable value
-- local notation `fixed_size` := fixed_size value

instance : fixed_storable value :=
{ repr := λ p v, p.get ↦ v,
  -- bytes := λ v, ⟨[v], rfl⟩,
  fixed_size := 1,
  pos_size := by norm_num,
  -- abstr := λ x, value_abstr _ x.property,
  -- right_inverse := λ ⟨[x],rfl⟩, rfl,
  -- raw_bytes_conversion := λ p x, rfl
 }

def word (α) [fixed_storable α] := { bytes : list value // length bytes = fixed_size value α }

local notation `word` := word value

variables {value}

def list_repr' {α β} [storable α] : tptr (list α) → list α → tptr β → hProp
| p [] q := [| p = q.recast (list α) |]
| p (v :: vs) q := p.recast α ⤇ v ⊛ list_repr' (p +. size value v) vs q

def value_abstr : Π vs : list value, length vs = 1 → value
| [val] rfl := val

def list_repr {α} [storable α] : tptr (list α) → list α → hProp
| p [] := emp
| p (v :: vs) := p.recast α ⤇ v ⊛ list_repr (p +. size value v) vs

lemma list_repr_map {α β} [storable α] [storable β]
  (p : tptr (list α)) {f : β → α} (xs : list β)
  (h : ∀ (q : tptr α) x, q ⤇ f x = (q.recast _ ⤇ x))
  (h' : ∀ x : β, size value (f x) = size value x ):
  list_repr p (xs.map f) = (list_repr (p.recast _) xs) :=
begin
  induction xs generalizing p, refl,
  simp [list_repr,*], refl
end

@[simp, separation_logic]
lemma fixed_size_val : fixed_size value value = 1 := rfl

@[simp, separation_logic]
lemma size_val (x : value) : size value x = 1 := rfl

attribute [simp, separation_logic] fixed_storable.is_fixed

lemma list_repr'_eq_list_repr {α β} [fixed_storable α] (p : tptr (list α)) (q : tptr β) (ls : list α) :
  list_repr' p ls q = list_repr p ls ⊛ [| p +. ls.length * fixed_size value α = q.recast _ |] :=
by induction ls generalizing p; simp [list_repr',list_repr,*,right_distrib,hProp.and_assoc]; congr

instance list.storable {α} [storable α] : storable (list α) :=
{ repr := list_repr,
  size := λ vs, list.sum $ vs.map (storable.size value)
  }

variables value

class is_record (α : Type*) extends fixed_storable α :=
(abstr : word α → α)
(bytes : α → word α)
(repr := λ p v, p.recast _ ⤇ (bytes v).val)
(right_inverse : right_inverse abstr bytes)
(raw_bytes_conversion : ∀ (p : tptr α) (x : α), (p ⤇ x) = (p.recast _ ⤇ (bytes x).val : hProp))

export is_record (abstr bytes raw_bytes_conversion)

local notation `is_record` := is_record value

def bytes' {α} [is_record α] (x : α) : list value :=
(bytes value x).val

lemma length_bytes' {α} [is_record α] (x : α) : length (bytes' value x) = fixed_size value α :=
(bytes value x).property

lemma bytes_surjective (α) [is_record α] : surjective (bytes value : α → word α) :=
surjective_of_has_right_inverse ⟨abstr, is_record.right_inverse _ _⟩

variables {value}

lemma uninitialized {α} [is_record α] (p : tptr α) :
  (∃∃ bytes : list value, [|length bytes = fixed_size value α|] ⊛ (p.recast _ ⤇ bytes)) =
   ∃∃ obj : α, p ⤇ obj :=
by rw ← exists_subtype; symmetry; apply exists_congr' (bytes value) (bytes_surjective value α);
   intro x; apply raw_bytes_conversion

@[simp, separation_logic]
lemma repr_nil {α} [storable α] (p : tptr (list α)) :
  p ⤇ [] = @emp value :=
by { dsimp [storable.repr], simp [list_repr], }

@[simp, separation_logic]
lemma repr_cons {α} [storable α] (p : tptr (list α)) (x) (xs : list α) :
  p ⤇ (x :: xs) = (p.recast _ ⤇ x ⊛ p+.size value x ⤇ xs : hProp) :=
by { dsimp [storable.repr], simp [list_repr], }

lemma maplets_append' {α} [fixed_storable α] : Π (p : tptr (list α)) (us vs : list α), (p ⤇ (us ++ vs)) = (p ⤇ us) ⊛ (p+.fixed_size value α * length us ⤇ vs)
| p [] vs := by simp
| p (u::us) vs := by simp [*,hProp.and_assoc,left_distrib]

lemma maplets_append : Π (p : tptr (list value)) (us vs : list value), (p ⤇ (us ++ vs)) = (p ⤇ us) ⊛ (p+.length us ⤇ vs)
| p [] vs := by simp
| p (u::us) vs := by simp [*,hProp.and_assoc]

@[simp, separation_logic]
lemma value_repr (p : ptr) (x : value) :
  tptr.mk value value p ⤇ x = p ↦ x :=
by { dsimp [storable.repr], simp [list_repr], }

@[simp, separation_logic]
lemma get_value_repr (p : tptr value) (x : value) :
  p ⤇ x = p.get ↦ x :=
by { dsimp [storable.repr], simp [list_repr], }

@[simp, separation_logic]
lemma tptr.recast_mk {α β} : Π (p : ptr), (tptr.mk value α p).recast β = tptr.mk value β p
| p := rfl

@[simp, separation_logic]
lemma tptr.recast_get {α β} : Π (p : tptr α), (p.recast β).get = p.get
| p := rfl

@[simp]
lemma disjoint_maplet_heap_mk_of_lt {p q : ℕ} (x : value) (xs : list value) (H : p < q) : disjoint (maplet p x) (heap.mk (enum_from q xs)) :=
by intros x; simp; intros H₀ H₁; subst x; cases not_le_of_lt H H₁

@[simp]
lemma disjoint_maplet_heap_mk_one_add {p : ℕ} (x : value) (xs : list value) : disjoint (maplet p x) (heap.mk (enum_from (1 + p) xs)) :=
disjoint_maplet_heap_mk_of_lt x xs ((nat.one_add p).symm ▸ nat.lt_succ_self _)

@[simp]
lemma disjoint_maplet_heap_mk_add_one {p : ℕ} (x : value) (xs : list value) : disjoint (maplet p x) (heap.mk (enum_from (p + 1) xs)) :=
disjoint_maplet_heap_mk_of_lt x xs (nat.lt_succ_self _)

lemma maplets_eq (p : tptr _) (vs : list value) (h : heap) : (p ⤇ vs) h ↔ h = heap.mk (vs.enum_from p.get) :=
begin
  induction vs generalizing p h; simp [maplets,emp,map,enum_from],
  simp [map,to_finmap_cons,separation.hProp.and,vs_ih,maplets,(+.)], split,
  { rintro ⟨h₀,h₁,hh₀,hh₁,hh₂⟩, rw [eq_union_of_eq_add hh₀,← hh₁,← hh₂] },
  { intro hh, refine ⟨_,_,_,rfl,rfl⟩, rw [← union_eq_add_of_disjoint, ← hh],
    simp }
end

@[simp, separation_logic]
lemma tptr.recast_recast {α β γ} (p : tptr α) : (p.recast β).recast γ = (p.recast γ : tptr γ) := rfl

@[simp, separation_logic]
lemma tptr.recast_eq {α} : Π (p : tptr α), (p.recast α) = p
| ⟨ _, _,_ ⟩ := rfl

instance : is_record value :=
{ repr := λ p v, p.get ↦ v,
  bytes := λ v, ⟨[v], rfl⟩,
  fixed_size := 1,
  pos_size := by norm_num,
  abstr := λ x, value_abstr _ x.property,
  right_inverse := λ ⟨[x],rfl⟩, rfl,
  raw_bytes_conversion := λ p x, by simp; refl }

def rec_bytes {α} [is_record α] (ls : list α) : list value :=
(ls.map (bytes' value)).join

lemma rec_bytes_cons {α} [is_record α] (x) (xs : list α) : rec_bytes (x :: xs) = bytes' value x ++ rec_bytes xs := rfl

lemma length_rec_bytes {α} [is_record α] (xs : list α) :
  length (rec_bytes xs : list value) = length xs * fixed_size value α :=
begin
  simp [rec_bytes], induction xs; simp [length,*,right_distrib],
  erw (bytes value xs_hd).property,
end

open «fixed_storable» list

lemma uninitialized' {α} [is_record α] (p : tptr α) :
  (∃∃ obj : α, p ⤇ obj) = (∃∃ bytes : list value, [| length bytes = fixed_size value α |] ⊛ p.recast _ ⤇ bytes) :=
by cases p; rw uninitialized

variable (value)

structure rec_entry :=
mk' ::
{α : Type*}
[S : is_record α]
(get : α)

attribute [instance] rec_entry.S

def rec_entry.mk_ {α : Type} [I : is_record α] (x : α) : rec_entry value := ⟨_,x⟩

instance : storable (rec_entry value) :=
{ repr := λ p x, p.recast _ ⤇ x.get,
  size := λ x, storable.size value x.get, }

variables {value}

def rec_entry_bytes : rec_entry value → list value
| (@rec_entry.mk' ._ α _inst get) := @bytes' value α _inst get

def rec_bytes' (ls : list (rec_entry value)) : list value :=
(ls.map (rec_entry_bytes)).join

-- end hProp

instance fixed_storable.word {α} [fixed_storable α] : fixed_storable (word α) :=
{ repr := λ p v, p.recast _ ⤇ v.val,
  fixed_size := fixed_size value α,
  pos_size := fixed_storable.pos_size value α }

def word.bytes {α} [fixed_storable α] : word α → word (word α)
| ⟨x,hx⟩ := ⟨x,hx⟩

def word.abstr {α} [fixed_storable α] : word (word α) → word α
| ⟨x,hx⟩ := ⟨x,hx⟩

-- @[simp, separation_logic]
-- lemma val_repr {val} (p : tptr (list val)) (vs : list val) : p ⤇ vs = p.get ↦ vs :=
-- begin
--   cases p, dsimp [storable.repr,tptr.recast],
--   induction vs generalizing p, refl,
--   rw maplets_cons, simp [list_repr,tptr.add,fixed_size,*], refl
-- end

instance word.is_record {α} [fixed_storable α] : is_record (word α) :=
{ bytes := word.bytes,
  abstr := word.abstr,
  right_inverse := λ ⟨x,hx⟩, rfl,
  raw_bytes_conversion := λ ⟨_,_,p⟩ ⟨x,hx⟩,
    by { simp [tptr.recast_mk,word.bytes]; refl } }

def equiv.is_record {α β} (f : β → α) (g : α → β) (hfg : left_inverse f g) [is_record α] : is_record β :=
{ repr := λ p x, p.recast _ ⤇ f x,
  bytes := bytes value ∘ f,
  abstr := g ∘ abstr,
  fixed_size := fixed_size value α,
  pos_size := fixed_storable.pos_size value α,
  is_fixed := λ x, rfl,
  right_inverse := λ ⟨x,hx⟩, by dsimp [bytes]; rw [hfg];
                               exact (is_record.right_inverse value α ⟨x,hx⟩),
  raw_bytes_conversion := λ ⟨_,_,p⟩ x, raw_bytes_conversion ⟨value,α,p⟩ (f x)
 }

lemma repr_map_bytes {α} [is_record α] (p : tptr (list (word α))) (xs : list α) :
  p ⤇ xs.map (bytes value) = (p.recast _ ⤇ xs : hProp) :=
show list_repr p (xs.map (bytes value)) = list_repr (p.recast _) xs,
begin
  rw [list_repr_map],
  { intros, symmetry, -- erw val_repr, cases q,
    rw [raw_bytes_conversion], refl },
  intro, simp [fixed_storable.is_fixed], refl
end

lemma repr_map_abstr {α} [is_record α] (p : tptr (list α)) (xs : list (word α)) :
  p ⤇ xs.map abstr = (p.recast _ ⤇ xs) :=
begin
  have := repr_map_bytes (p.recast _) (xs.map abstr),
  simp at this, rw ← this, congr,
  transitivity xs.map id,
  { congr, ext, exact is_record.right_inverse value α x },
  { simp only [list.map_id] }
end

@[separation_logic]
lemma list_repr_recast {α β} (γ) [storable α] (vs : list α)
  (p : tptr (list α)) (q : tptr β) :
  list_repr' p vs (q.recast γ) = list_repr' p vs q :=
begin
  cases q, dsimp [tptr.recast],
  induction vs generalizing p, refl, simp [list_repr',*]
end

end separation

namespace tactic

variables {value : Type}
open separation separation.hProp

local notation `hProp` := hProp value
setup_tactic_parser

lemma shrink_impl (l m r : hProp) {p q : hProp}
  (h₀ : l ⊛ m = p) (h₁ : r ⊛ m = q) (h₂ : l =*> r) :
  p =*> q :=
h₀ ▸ (h₁ ▸ and_impl_and h₂ $ impl_refl _)

lemma split_impl (p₀ p₁ q₀ q₁ : hProp) {p q : hProp}
  (h₀ : p₀ ⊛ p₁ = p) (h₁ : q₀ ⊛ q₁ = q) (h₂ : p₀ =*> q₀) (h₃ : p₁ =*> q₁) :
  p =*> q :=
h₀ ▸ (h₁ ▸ and_impl_and h₂ h₃)

meta def parse_assert' : expr → tactic (dlist expr)
| `(%%p ⊛ %%q) := (++) <$> parse_assert' p <*> parse_assert' q
| `(emp) := pure dlist.empty
| p := pure $ dlist.singleton p

meta def parse_assert (e : expr) : tactic (list expr) :=
dlist.to_list <$> parse_assert' e

meta def mk_assert (val : expr) : list expr → expr
| [] := @expr.const tt ``emp [] val
| [x] := x
| (x::xs) :=
@expr.const tt ``hProp.and [] val x (mk_assert xs)

meta def ac_refl_aux : tactic unit :=
do `[dsimp { fail_if_unchanged := ff }],
   (lhs, rhs) ← target >>= match_eq,
   xs ← parse_assert lhs,
   with_context!"{target}" $ do
     xs.mmap' $ λ x, generalize x >> intro1,
     cc <|> fail "ac_refl_aux"

meta def ac_refl' : tactic unit :=
do try (applyc ``impl_of_eq),
   -- target >>= instantiate_mvars >>= change,
   -- `[dsimp],
   with_context!"{target}" $ do
   cc <|>
     ac_refl_aux
     -- <|>
     -- fail!"ac_refl': {target}\nmeta vars: {expr.list_meta_vars <$> target}"

meta def find_lift : list expr → tactic (option (expr × list expr))
| [] := pure none
| (x@`(separation.hProp.lift _) :: xs) := pure (some (x, xs))
| (x :: xs) :=
  do some (y, ys) ← find_lift xs | pure none,
     pure (some (y, x::ys))

@[replaceable]
meta def s_intro' (n : parse $ ident_ <|> pure `_) : tactic unit :=
do `[simp only [and_p_exists_distrib_left,and_p_exists_distrib_right]
               { fail_if_unchanged := ff }],
   `(@impl %%val %%p %%q) ← target | fail "Expecting separation logic specification",
   match p with
   | `(p_exists _) :=
     do applyc ``exists_impl,
        intro n >> pure ()
   | _ :=
   do xs ← parse_assert p,
      some (x, xs) ← find_lift xs | failed,
      let p' := mk_assert val (x :: xs),
      g ← mk_app `eq [p,p'] >>= mk_meta_var,
      gs ← get_goals, set_goals [g],
      `[simp only [and_emp,emp_and] { fail_if_unchanged := ff } ],
      done <|> ac_refl',
      set_goals gs,
      get_assignment g >>= rewrite_target,
      applyc ``lift_and_impl <|> applyc ``lift_impl,
      intro n, pure ()
   end

meta def interactive.s_intro (n : parse $ ident_ <|> pure `_) : tactic unit :=
s_intro n

@[interactive]
meta def s_intros : parse ident_* → tactic unit
| [] := repeat (s_intro `_)
| ns := ns.mmap' s_intro

@[interactive]
meta def s_existsi (wit : parse pexpr_list_or_texpr) : tactic unit :=
wit.mmap' $ λ w,
  do `(%%p =*> %%q) ← target,
     `[simp only [and_p_exists_distrib_left,and_p_exists_distrib_right] { fail_if_unchanged := ff }],
     refine ``(impl_exists %%w _) <|>
       do `[simp only [lift_and_iff_p_exists] { single_pass := tt } ],
          `[simp only [and_p_exists_distrib_left,and_p_exists_distrib_right]
                 { fail_if_unchanged := ff } ],
          refine ``(impl_exists %%w _)

lemma lin_assert {p q : hProp} (pp : Prop) (h : p =*> [| pp |] ⊛ p) (h' : pp → p =*> q) : p =*> q :=
impl_trans h
  (by s_intro h; exact h' h)

lemma lin_assert' {p q : hProp} (pp : Prop) (h : p =*> [| pp |] ⊛ True) (h' : pp → p =*> q) : p =*> q :=
begin
  transitivity [| pp |] ⊛ p,
  { rw lift_p_and_and, apply impl_and h (impl_refl _) },
  { s_intro h, exact h' h }
end

@[interactive]
meta def s_assert (h : parse $ ident? <* tk ":") (e : parse texpr) : tactic unit :=
let h := h.get_or_else `this in
refine ``(lin_assert' %%e _ _); [skip, ()<$intro h]

meta def find_frame' (e : expr) : list expr → tactic (list expr)
| [] := fail "frame not found"
| (x :: xs) :=
  xs <$ unify e x <|>
  list.cons x <$> find_frame' xs

meta def find_frame_aux : list expr → list expr → tactic (list expr)
| [] xs := pure xs
| (x::xs) ys :=
  do ys' ← find_frame' x ys,
     find_frame_aux xs ys'

meta def find_diff : list expr → list expr → tactic (list expr × list expr × list expr)
| [] xs := pure ([], [], xs)
| (x::xs) ys :=
  do (b,ys') ← prod.mk tt <$> find_frame' x ys <|> pure (ff,ys),
     (l,m,r) ← find_diff xs ys',
     if b
       then pure (l,x::m,r)
       else pure (x::l,m,r)

/--
`find_frame e e'` returns `r` and `pr` such that `pr : e ⊛ r = e'`
-/
meta def find_frame (e e' : expr) : tactic (expr × expr) :=
do `(«hProp» %%val) ← infer_type e,
   le ← parse_assert e,
   le' ← parse_assert e',
   lr ← find_frame_aux le le',
   let r := mk_assert val lr,
   t ← to_expr ``(%%e ⊛ %%r = %%e') >>= instantiate_mvars,
   (_,pr) ← solve_aux t
     (`[simp only [emp_and,and_emp] { fail_if_unchanged := ff } ]; ac_refl'),
   pure (r,pr)

@[replaceable]
meta def s_shrink' : tactic unit :=
do `(%%p =*> %%q) ← target,
   `(«hProp» %%val) ← infer_type p,
   ps ← parse_assert p,
   qs ← parse_assert q,
   (l,m,r) ← find_diff ps qs,
   guard (¬ m.empty) <|> fail "no common clauses",
   let l := mk_assert val l,
   let m := mk_assert val m,
   let r := mk_assert val r,
   to_expr ``(shrink_impl %%l %%m %%r) >>= apply,
   iterate_exactly 2 $ solve1 $ interactive.hide_meta_vars { } $ λ _, do
   { `[simp { fail_if_unchanged := ff } ],
     done <|> cc },
   try reflexivity

attribute [interactive] s_shrink

@[replaceable]
meta def entailment' : tactic unit :=
focus1 $
assumption <|>
do intros,
   target >>= instantiate_mvars >>= change,
   when_tracing `separation.failed_spec (trace "A" >> trace_state),
   with_context!"• A: {target}" $ do
     `[simp [hProp.and_p_exists_distrib_left,hProp.and_p_exists_distrib_right] with separation_logic
       { fail_if_unchanged := ff } ],
     when_tracing `separation.failed_spec (trace "B" >> trace_state),
     with_context!"• B: {try_core target}" $ do
       iterate_at_most 10 $ do
         { `(_ =*> p_exists _) ← target,
           applyc ``impl_exists },
       when_tracing `separation.failed_spec (trace "C" >> trace_state),
       with_context!"• C: {try_core target}" $ do
       done <|>
         assumption <|>
         ac_refl'
     -- s_shrink <|>
  -- (try (applyc ``impl_of_eq); ac_refl) <|>

attribute [interactive] entailment

meta def s_apply' (e : expr) : tactic unit :=
do t ← infer_type e,
   (args,`(%%p =*> %%q)) ← mk_meta_pis t,
   let e := e.mk_app args,
   `(%%p' =*> %%q') ← target,
   frp ← some <$> find_frame p p' <|> pure none,
   frq ← some <$> find_frame q q' <|> pure none,
   match frp, frq with
   | some (pr,pp), some (qr,qp) := refine ``(split_impl %%p %%pr %%q %%qr %%pp %%qp %%e _)
   | some (pr,pp), none := refine ``(impl_trans (shrink_impl %%p %%pr %%q %%pp rfl %%e) _)
   | none, some (qr,qp) := refine ``(impl_trans _ (shrink_impl %%p %%qr %%q rfl %%qp %%e))
   | none, none := fail!"No match found for `{e} : {t}`"
   end,
   try (reflexivity <|> applyc ``impl_True)

@[interactive]
meta def s_apply : parse types.pexpr_list_or_texpr → tactic unit :=
mmap' $ to_expr >=> s_apply'

@[interactive]
meta def s_assumptions : tactic unit :=
do cxt ← local_context,
   focus1 $ cxt.for_each $ λ l, try $ s_apply' l

@[interactive]
meta def s_assumption : tactic unit :=
do cxt ← local_context,
   focus1 $ cxt.any_of $ λ l, try $ s_apply' l

@[interactive]
meta def s_show (p : parse texpr) : tactic unit :=
do g ← to_expr p >>= mk_meta_var,
   s_apply' g

lemma prop_proof {p : Prop} {q : hProp} (h : p) : q =*> [| p |] ⊛ True :=
impl_lift_and h impl_True

lemma prop_proof' {p : Prop} {q : hProp} (h : p) : q =*> True ⊛ [| p |] :=
impl_trans (prop_proof h) (impl_of_eq $ hProp.and_comm _ _)

lemma prop_impl_False {q : hProp} (h : false) : q =*> False :=
impl_trans (prop_proof h) (by simp)

@[interactive]
meta def prop (ls : parse ident_*) : tactic unit :=
do s_intros ls,
   applyc ``prop_proof
   <|> applyc ``prop_proof'
   <|> applyc ``prop_impl_False

end tactic

namespace separation

open hProp list

variables {value : Type} {α : Type*} {β : Type*} {γ : Type*}
include value
local notation `hProp` := hProp value
local notation `tptr` := tptr value

lemma p_exists_one_point {q : α → hProp} (x : α)
  (h : ∀ y, q y =*> [|y = x|] ⊛ q y):
  p_exists q = q x :=
impl_antisymm
  (by { s_intros y, transitivity, apply h,
        s_intro hxy, rw hxy })
  (by { apply impl_exists x, refl } )

section storable

variables [storable value α]

lemma list_repr_and_list_repr_impl_list_repr'_concat {us vs : list α}
  (p q : tptr (list α)) (r : tptr β) :
  list_repr' p us q ⊛ list_repr' q vs r =*> list_repr' p (us ++ vs) r :=
begin
  induction us generalizing p,
  { simp [list_repr'],
    apply lift_and_impl, intro h, subst h },
  { simp [list_repr',hProp.and_assoc],
    apply and_impl_and (impl_refl _) (us_ih _) }
end

lemma list_repr_append {us vs : list α}
  (p : tptr (list α)) (r : tptr β) :
  list_repr' p (us ++ vs) r = list_repr' p us (p +. size value us) ⊛ list_repr' (p +. size value us) vs r :=
by induction us generalizing p; simp [list_repr',size,*,separation.hProp.and_assoc]

lemma list_repr_impl_le (p₀ : tptr (list α)) (p₁ : tptr β) (vs : list α) :
  list_repr' p₀ vs p₁ =*> [| p₀ ≤ p₁.recast _ |] ⊛ True :=
begin
  induction vs generalizing p₀,
  { simp [list_repr'], prop h, rw h },
  { simp [list_repr'], s_apply vs_ih, prop h,
    apply le_trans (le_offset _) h, }
end

lemma list_repr_impl_le' {p₀ p₁ : tptr (list α)} (vs : list α) :
  list_repr' p₀ vs p₁ =*> [| p₀ ≤ p₁ |] ⊛ True :=
list_repr_impl_le _ _ _

lemma list_repr_eq_of_gt {p q : tptr (list α)} {vs : list α} (h : q < p) :
  list_repr' p vs q = False :=
begin
  apply impl_antisymm _ (False_impl _),
  apply impl_trans (list_repr_impl_le' _),
  simp [not_le_of_gt h],
end

end storable

section fixed_storable

variables [fixed_storable value α]

lemma list_repr_self_impl_eq_nul (p₀ : tptr (list α)) (vs : list α) :
  list_repr' p₀ vs p₀ =*> [| vs = [] |] :=
begin
  induction vs generalizing p₀; simp [list_repr'],
  s_apply list_repr_impl_le, prop h, revert h,
  apply not_le_of_gt, simp, apply gt_offset_of_gt _ (fixed_storable.pos_size _ α),
end

lemma list_repr_self_impl_eq_nul' (p₀ : tptr (list α)) (vs : list α) :
  list_repr' p₀ vs (p₀.recast β) =*> [| vs = [] |] :=
(@list_repr_recast value _ _ β _ vs p₀ p₀).symm ▸ (list_repr_self_impl_eq_nul p₀ vs)

lemma list_repr_offset {vs : list α}
  (p : tptr (list α)) (n : ℕ) :
  list_repr' p vs (p +. n * fixed_size value α) = [| length vs = n |] ⊛ p ⤇ vs :=
begin
  induction vs generalizing n p,
  { have : p = p +. n * fixed_size value α ↔ 0 = n,
    { split; intro h,
      by_contradiction h',
      { replace h' := nat.pos_of_ne_zero (ne.symm h'),
        have h₂ : n * fixed_size value α > 0 := mul_pos h' (fixed_storable.pos_size _ _),
        exact offset_ne _ h₂ h.symm },
      { simp [h.symm] }, },
    simp [list_repr',this,*], },
  simp [list_repr',*], -- specialize vs_ih (n - 1) (p +. size value vs_hd),
  cases nat.eq_zero_or_pos n,
  { subst n,
    have : p < p +. fixed_size value α := gt_offset_of_gt _ _,
    simp [list_repr_eq_of_gt this], apply fixed_storable.pos_size },
  specialize vs_ih (n - 1) (p +. size value vs_hd),
  replace h := nat.succ_le_of_lt h,
  have := nat.mul_le_mul_right (fixed_size value α) h,
  simp at this,
  simp [nat.add_sub_cancel' this,nat.mul_sub_right_distrib] at vs_ih,
  rw [vs_ih, @eq_comm _ (length vs_tl), nat.sub_eq_iff_eq_add h, @eq_comm _ _ (length vs_tl + 1), nat.add_comm],
  ac_refl,
end

lemma recast_inj (p q : tptr α) : p.recast β = (q.recast β) ↔ p = q :=
by cases p; cases q; simp

def trashed (p : tptr α) : hProp :=
∃∃ trash : list value, [| length trash = fixed_size value α |] ⊛ p.recast _ ⤇ trash

def unused : tptr (list $ word value α) → ℕ → tptr β → hProp
| p 0 q := [| p = q.recast _ |]
| p (nat.succ n) q := trashed (p.recast α) ⊛ unused (p +. fixed_size value α) n q

@[simp, separation_logic]
lemma unused_recast (p : tptr (list $ word value α)) (q : tptr β) (n : ℕ) :
  unused p n (q.recast γ) = unused p n q :=
by induction n generalizing p; simp [unused,*]

@[simp]
lemma fixed_size_word : fixed_size value (word value α) = fixed_size value α := rfl

lemma unused_iff_exists (p : tptr (list (word value α))) (q : tptr β) (n : ℕ) :
  unused p n q = ∃∃ val : list (word value α), [| length val = n |] ⊛ list_repr' p val q :=
begin
  induction n generalizing p,
  { rw p_exists_one_point [], simp [unused,list_repr'],
    intros, s_intros h, apply impl_lift_and,
    rw ← length_eq_zero, exact h,
    apply impl_lift_and h (impl_refl _), },
  { rw [unused,n_ih,trashed,← exists_subtype],
    simp [and_p_exists_distrib_left,and_p_exists_distrib_right],
    apply impl_antisymm,
    { s_intros x xs Hxs, apply impl_exists (x :: xs),
      simp [Hxs,list_repr'], apply impl_refl _, },
    { s_intros xs Hxs, rw length_eq_succ at Hxs,
      rcases Hxs with ⟨y,ys,h,h'⟩, subst xs,
      apply impl_exists y, apply impl_exists ys, simp [list_repr',h'],
      refl } }
end

lemma unused_impl_le' {p₀ p₁ : tptr (list (word value α))} (n : ℕ) :
  unused p₀ n p₁ =*> [| p₀ ≤ p₁ |] ⊛ True :=
begin
  rw unused_iff_exists, s_intros val Hval,
  apply list_repr_impl_le
end

end fixed_storable

end separation
-- α

-- ```
-- section
-- variable [𝓛 : sep_logic]
-- include 𝓛
-- -- maintenant `hProp` et `tptr α` (le type des pointeurs typés qui pointent vers α)
-- -- réfèrent automatiquement α 𝓛 sans qu'on ait à créer de raccourcis


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.int.char_zero
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Cast.Field

/-!
# Injectivity of `int.cast` into characteristic zero rings and fields.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

-/

variable {α : Type _}

open Nat

namespace Int

/- warning: int.cast_eq_zero -> Int.cast_eq_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {n : Int}, Iff (Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α _inst_1)))) n) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (AddZeroClass.toHasZero.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddMonoidWithOne.toAddMonoid.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)))))))) (Eq.{1} Int n (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {n : Int}, Iff (Eq.{succ u1} α (Int.cast.{u1} α (AddGroupWithOne.toIntCast.{u1} α _inst_1) n) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (NegZeroClass.toZero.{u1} α (SubNegZeroMonoid.toNegZeroClass.{u1} α (SubtractionMonoid.toSubNegZeroMonoid.{u1} α (AddGroup.toSubtractionMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α _inst_1)))))))) (Eq.{1} Int n (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)))
Case conversion may be inaccurate. Consider using '#align int.cast_eq_zero Int.cast_eq_zeroₓ'. -/
@[simp]
theorem cast_eq_zero [AddGroupWithOne α] [CharZero α] {n : ℤ} : (n : α) = 0 ↔ n = 0 :=
  ⟨fun h => by
    cases n
    · rw [Int.cast_ofNat] at h
      exact congr_arg coe (Nat.cast_eq_zero.1 h)
    · rw [cast_neg_succ_of_nat, neg_eq_zero, Nat.cast_eq_zero] at h
      contradiction, fun h => by rw [h, cast_zero]⟩
#align int.cast_eq_zero Int.cast_eq_zero

/- warning: int.cast_inj -> Int.cast_inj is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {m : Int} {n : Int}, Iff (Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α _inst_1)))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α _inst_1)))) n)) (Eq.{1} Int m n)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {m : Int} {n : Int}, Iff (Eq.{succ u1} α (Int.cast.{u1} α (AddGroupWithOne.toIntCast.{u1} α _inst_1) m) (Int.cast.{u1} α (AddGroupWithOne.toIntCast.{u1} α _inst_1) n)) (Eq.{1} Int m n)
Case conversion may be inaccurate. Consider using '#align int.cast_inj Int.cast_injₓ'. -/
@[simp, norm_cast]
theorem cast_inj [AddGroupWithOne α] [CharZero α] {m n : ℤ} : (m : α) = n ↔ m = n := by
  rw [← sub_eq_zero, ← cast_sub, cast_eq_zero, sub_eq_zero]
#align int.cast_inj Int.cast_inj

/- warning: int.cast_injective -> Int.cast_injective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)], Function.Injective.{1, succ u1} Int α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α _inst_1)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)], Function.Injective.{1, succ u1} Int α (Int.cast.{u1} α (AddGroupWithOne.toIntCast.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align int.cast_injective Int.cast_injectiveₓ'. -/
theorem cast_injective [AddGroupWithOne α] [CharZero α] : Function.Injective (coe : ℤ → α)
  | m, n => cast_inj.1
#align int.cast_injective Int.cast_injective

/- warning: int.cast_ne_zero -> Int.cast_ne_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {n : Int}, Iff (Ne.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α _inst_1)))) n) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (AddZeroClass.toHasZero.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddMonoidWithOne.toAddMonoid.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)))))))) (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : AddGroupWithOne.{u1} α] [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α _inst_1)] {n : Int}, Iff (Ne.{succ u1} α (Int.cast.{u1} α (AddGroupWithOne.toIntCast.{u1} α _inst_1) n) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (NegZeroClass.toZero.{u1} α (SubNegZeroMonoid.toNegZeroClass.{u1} α (SubtractionMonoid.toSubNegZeroMonoid.{u1} α (AddGroup.toSubtractionMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α _inst_1)))))))) (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)))
Case conversion may be inaccurate. Consider using '#align int.cast_ne_zero Int.cast_ne_zeroₓ'. -/
theorem cast_ne_zero [AddGroupWithOne α] [CharZero α] {n : ℤ} : (n : α) ≠ 0 ↔ n ≠ 0 :=
  not_congr cast_eq_zero
#align int.cast_ne_zero Int.cast_ne_zero

/- warning: int.cast_div_char_zero -> Int.cast_div_charZero is a dubious translation:
lean 3 declaration is
  forall {k : Type.{u1}} [_inst_1 : DivisionRing.{u1} k] [_inst_2 : CharZero.{u1} k (AddGroupWithOne.toAddMonoidWithOne.{u1} k (AddCommGroupWithOne.toAddGroupWithOne.{u1} k (Ring.toAddCommGroupWithOne.{u1} k (DivisionRing.toRing.{u1} k _inst_1))))] {m : Int} {n : Int}, (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) n m) -> (Eq.{succ u1} k ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int k (HasLiftT.mk.{1, succ u1} Int k (CoeTCₓ.coe.{1, succ u1} Int k (Int.castCoe.{u1} k (AddGroupWithOne.toHasIntCast.{u1} k (AddCommGroupWithOne.toAddGroupWithOne.{u1} k (Ring.toAddCommGroupWithOne.{u1} k (DivisionRing.toRing.{u1} k _inst_1))))))) (HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.hasDiv) m n)) (HDiv.hDiv.{u1, u1, u1} k k k (instHDiv.{u1} k (DivInvMonoid.toHasDiv.{u1} k (DivisionRing.toDivInvMonoid.{u1} k _inst_1))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int k (HasLiftT.mk.{1, succ u1} Int k (CoeTCₓ.coe.{1, succ u1} Int k (Int.castCoe.{u1} k (AddGroupWithOne.toHasIntCast.{u1} k (AddCommGroupWithOne.toAddGroupWithOne.{u1} k (Ring.toAddCommGroupWithOne.{u1} k (DivisionRing.toRing.{u1} k _inst_1))))))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int k (HasLiftT.mk.{1, succ u1} Int k (CoeTCₓ.coe.{1, succ u1} Int k (Int.castCoe.{u1} k (AddGroupWithOne.toHasIntCast.{u1} k (AddCommGroupWithOne.toAddGroupWithOne.{u1} k (Ring.toAddCommGroupWithOne.{u1} k (DivisionRing.toRing.{u1} k _inst_1))))))) n)))
but is expected to have type
  forall {k : Type.{u1}} [_inst_1 : DivisionRing.{u1} k] [_inst_2 : CharZero.{u1} k (AddGroupWithOne.toAddMonoidWithOne.{u1} k (Ring.toAddGroupWithOne.{u1} k (DivisionRing.toRing.{u1} k _inst_1)))] {m : Int} {n : Int}, (Dvd.dvd.{0} Int Int.instDvdInt n m) -> (Eq.{succ u1} k (Int.cast.{u1} k (Ring.toIntCast.{u1} k (DivisionRing.toRing.{u1} k _inst_1)) (HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.instDivInt_1) m n)) (HDiv.hDiv.{u1, u1, u1} k k k (instHDiv.{u1} k (DivisionRing.toDiv.{u1} k _inst_1)) (Int.cast.{u1} k (Ring.toIntCast.{u1} k (DivisionRing.toRing.{u1} k _inst_1)) m) (Int.cast.{u1} k (Ring.toIntCast.{u1} k (DivisionRing.toRing.{u1} k _inst_1)) n)))
Case conversion may be inaccurate. Consider using '#align int.cast_div_char_zero Int.cast_div_charZeroₓ'. -/
@[simp, norm_cast]
theorem cast_div_charZero {k : Type _} [DivisionRing k] [CharZero k] {m n : ℤ} (n_dvd : n ∣ m) :
    ((m / n : ℤ) : k) = m / n :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp [Int.div_zero]
  · exact cast_div n_dvd (cast_ne_zero.mpr hn)
#align int.cast_div_char_zero Int.cast_div_charZero

end Int

/- warning: ring_hom.injective_int -> RingHom.injective_int is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] (f : RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.ring)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))], Function.Injective.{1, succ u1} Int α (coeFn.{succ u1, succ u1} (RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.ring)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) (fun (_x : RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.ring)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) => Int -> α) (RingHom.hasCoeToFun.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.ring)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) f)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] (f : RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) [_inst_2 : CharZero.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))], Function.Injective.{1, succ u1} Int α (FunLike.coe.{succ u1, 1, succ u1} (RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) Int (fun (_x : Int) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Int) => α) _x) (MulHomClass.toFunLike.{u1, 0, u1} (RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) Int α (NonUnitalNonAssocSemiring.toMul.{0} Int (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} Int (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)))) (NonUnitalNonAssocSemiring.toMul.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1))) (NonUnitalRingHomClass.toMulHomClass.{u1, 0, u1} (RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) Int α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} Int (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) (RingHomClass.toNonUnitalRingHomClass.{u1, 0, u1} (RingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1)) Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1) (RingHom.instRingHomClassRingHom.{0, u1} Int α (NonAssocRing.toNonAssocSemiring.{0} Int (Ring.toNonAssocRing.{0} Int Int.instRingInt)) (NonAssocRing.toNonAssocSemiring.{u1} α _inst_1))))) f)
Case conversion may be inaccurate. Consider using '#align ring_hom.injective_int RingHom.injective_intₓ'. -/
theorem RingHom.injective_int {α : Type _} [NonAssocRing α] (f : ℤ →+* α) [CharZero α] :
    Function.Injective f :=
  Subsingleton.elim (Int.castRingHom _) f ▸ Int.cast_injective
#align ring_hom.injective_int RingHom.injective_int


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebra.homology.homotopy
import algebra.homology.additive
import algebra.category.Group.abelian
import data.int.parity
import algebra.homology.short_exact.preadditive
import for_mathlib.algebra.homology.homological_complex_X_iso_of_eq

noncomputable theory

open category_theory category_theory.preadditive category_theory.limits category_theory.category

universes v u

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

namespace cochain_complex

variables {F G K L : cochain_complex C ℤ} (n m : ℤ)

/-- should be changed...-/
structure is_termwise_kernel (i : F ⟶ G) (f : G ⟶ K) :=
(zero : ∀ n, i.f n ≫ f.f n = 0)
(is_limit : ∀ n, is_limit (kernel_fork.of_ι (i.f n) (zero n)))

namespace is_termwise_kernel

lemma termwise_mono {i : F ⟶ G} {f : G ⟶ K}
  (h : is_termwise_kernel i f) (q : ℤ) : mono (i.f q) :=
mono_of_is_limit_fork (h.is_limit q)

end is_termwise_kernel

namespace hom_complex

def ε (n : ℤ) : ℤ := ↑((-1 : units ℤ) ^ n)

@[simp]

lemma ε_add (n₁ n₂ : ℤ) : ε (n₁ + n₂) = ε n₁ * ε n₂ :=
by { dsimp [ε], rw [← units.coe_mul, ← units.ext_iff, zpow_add], }

@[simp]
lemma ε_0 : ε 0 = 1 := rfl

@[simp]
lemma ε_1 : ε 1 = -1 := rfl

@[simp]
lemma ε_succ (n : ℤ) : ε (n + 1) = - ε n :=
by simp only [ε_add, ε_1, algebra.id.smul_eq_mul, mul_neg, mul_one]

lemma ε_even (n : ℤ) (hn : even n) : ε n = 1 :=
begin
  change _ = ↑(1 : units ℤ),
  cases hn with k hk,
  simp only [ε, ← units.ext_iff, hk, zpow_add, ← mul_zpow,
    mul_neg, mul_one, neg_neg, one_zpow],
end

lemma ε_odd (n : ℤ) (hn : odd n) : ε n = -1 :=
begin
  cases hn with k hk,
  rw [hk, ε_add, ε_1, ε_even (2*k) ⟨k, two_mul k⟩, one_mul],
end

lemma ε_eq_one_iff (n : ℤ) : ε n = 1 ↔ even n :=
begin
  split,
  { intro h,
    rw int.even_iff_not_odd,
    intro h',
    rw ε_odd _ h' at h,
    linarith, },
  { intro h,
    rw ε_even _ h, },
end

lemma ε_eq_neg_one_iff (n : ℤ) : ε n = -1 ↔ odd n :=
begin
  split,
  { intro h,
    rw int.odd_iff_not_even,
    intro h',
    rw ε_even _ h' at h,
    linarith, },
  { intro h,
    rw ε_odd _ h, },
end

lemma ε_neg (n : ℤ) : ε (-n) = ε n :=
begin
  dsimp [ε],
  simp only [zpow_neg, ← inv_zpow, inv_neg, inv_one],
end

lemma ε_sub (n₁ n₂ : ℤ) : ε (n₁ - n₂) = ε n₁ * ε n₂ :=
by simp only [sub_eq_add_neg, ε_add, ε_neg]

lemma ε_eq_iff (n₁ n₂ : ℤ) : ε n₁ = ε n₂ ↔
  even (n₁ - n₂) :=
begin
  by_cases h₂ : even n₂,
  { rw [ε_even _ h₂, int.even_sub, ε_eq_one_iff],
    tauto, },
  { rw [← int.odd_iff_not_even] at h₂,
    rw [ε_odd _ h₂, int.even_sub, ε_eq_neg_one_iff,
      int.even_iff_not_odd, int.even_iff_not_odd],
      tauto, }
end

@[simp]
lemma mul_ε_self (n : ℤ) : ε n * ε n = 1 :=
by simpa only [← ε_add] using ε_even _ (even_add_self n)

@[simp]
lemma ε_mul_self (n : ℤ) : ε (n * n) = ε n :=
begin
  by_cases hn : even n,
  { rw [ε_even _ hn, ε_even],
    obtain ⟨k, rfl⟩ := hn,
    exact ⟨2*k*k, by ring⟩, },
  { rw [← int.odd_iff_not_even] at hn,
    rw [ε_odd _ hn],
    obtain ⟨k, rfl⟩ := hn,
    rw [ε_odd],
    exact ⟨2*k*k + 2*k, by ring⟩, },
end

structure triplet (n : ℤ) := (p : ℤ) (q : ℤ) (hpq : q=p+n)

variables (F G)

@[derive add_comm_group]
def cochain := Π (T : triplet n), F.X T.p ⟶ G.X T.q

namespace cochain

variables {F G n}

def mk (v : Π (p q : ℤ) (hpq : q=p+n), F.X p ⟶ G.X q) : cochain F G n :=
λ T, v T.p T.q T.hpq

def v (c : cochain F G n) (p q : ℤ) (hpq : q=p+n) := c (triplet.mk p q hpq)

@[simp]
lemma mk_v (v : Π (p q : ℤ) (hpq : q=p+n), F.X p ⟶ G.X q) (p q : ℤ) (hpq : q=p+n) :
  (mk v).v p q hpq = v p q hpq := rfl

lemma congr_v {z₁ z₂ : cochain F G n} (h : z₁ = z₂) (p q : ℤ) (hpq : q=p+n) :
  z₁.v p q hpq = z₂.v p q hpq := by subst h

@[ext]
lemma ext (z₁ z₂ : cochain F G n) (h : ∀ (p q : ℤ) (hpq : q=p+n), z₁.v p q hpq = z₂.v p q hpq) :
  z₁ = z₂ :=
begin
  ext T,
  rcases T with ⟨p, q, hpq⟩,
  exact h p q hpq,
end

@[ext]
lemma ext₀ (z₁ z₂ : cochain F G 0)
  (h : ∀ (p : ℤ), z₁.v p p (add_zero p).symm = z₂.v p p (add_zero p).symm ) : z₁ = z₂ :=
begin
  ext,
  have eq : q=p := by rw [hpq, add_zero],
  subst eq,
  apply h,
end

@[simp]
lemma zero_v {n : ℤ} (p q : ℤ) (hpq : q=p+n) : (0 : cochain F G n).v p q hpq = 0 := rfl

@[simp]
lemma add_v {n : ℤ} (z₁ z₂ : cochain F G n) (p q : ℤ) (hpq : q=p+n) :
  (z₁+z₂).v p q hpq = z₁.v p q hpq + z₂.v p q hpq := rfl

@[simp]
lemma sub_v {n : ℤ} (z₁ z₂ : cochain F G n) (p q : ℤ) (hpq : q=p+n) :
  (z₁-z₂).v p q hpq = z₁.v p q hpq - z₂.v p q hpq := rfl

@[simp]
lemma neg_v {n : ℤ} (z : cochain F G n) (p q : ℤ) (hpq : q=p+n) :
  (-z).v p q hpq = - (z.v p q hpq) := rfl

@[simp]
lemma zsmul_v {n k : ℤ} (z : cochain F G n) (p q : ℤ) (hpq : q=p+n) :
  (k • z).v p q hpq = k • (z.v p q hpq) := rfl

def of_homs (ψ : Π (p : ℤ), F.X p ⟶ G.X p) : cochain F G 0 :=
cochain.mk (λ p q hpq, ψ p ≫ eq_to_hom (by rw [hpq, add_zero]))

@[simp]
lemma of_homs_v (ψ : Π (p : ℤ), F.X p ⟶ G.X p) (p : ℤ) :
  (of_homs ψ).v p p (add_zero p).symm = ψ p :=
by simp only [of_homs, mk_v, eq_to_hom_refl, comp_id]

@[simp]
lemma of_homs_zero : of_homs (λ p, (0 : F.X p ⟶ G.X p)) = 0 :=
by { ext, simp only [of_homs_v, zero_v], }

@[simp]
lemma of_homs_v_comp_d (ψ : Π (p : ℤ), F.X p ⟶ G.X p) (p q q' : ℤ) (hpq : q=p+0) :
  (of_homs ψ).v p q hpq ≫ G.d q q' = ψ p ≫ G.d p q' :=
begin
  rw add_zero at hpq,
  subst hpq,
  rw of_homs_v,
end

@[simp]
lemma d_comp_of_homs_v (ψ : Π (p : ℤ), F.X p ⟶ G.X p) (p' p q  : ℤ) (hpq : q=p+0) :
  F.d p' p ≫ (of_homs ψ).v p q hpq = F.d p' q ≫ ψ q :=
begin
  rw add_zero at hpq,
  subst hpq,
  rw of_homs_v,
end

def of_hom (φ : F ⟶ G) : cochain F G 0 :=
of_homs (λ p, φ.f p)

@[simp]
lemma of_hom_zero : of_hom (0 : F ⟶ G) = 0 :=
by simp only [of_hom, homological_complex.zero_f_apply, of_homs_zero]

@[simp]
lemma of_hom_v (φ : F ⟶ G) (p : ℤ) : (of_hom φ).v p p (add_zero p).symm = φ.f p :=
by simp only [of_hom, of_homs_v]

@[simp]
lemma of_hom_v_comp_d (φ : F ⟶ G) (p q q' : ℤ) (hpq : q=p+0) :
  (of_hom φ).v p q hpq ≫ G.d q q' = φ.f p ≫ G.d p q' :=
by simp only [of_hom, of_homs_v_comp_d]

@[simp]
lemma d_comp_of_hom_v (φ : F ⟶ G) (p' p q  : ℤ) (hpq : q=p+0) :
  F.d p' p ≫ (of_hom φ).v p q hpq = F.d p' q ≫ φ.f q :=
by simp only [of_hom, d_comp_of_homs_v]

@[simp]
def of_homotopy {φ₁ φ₂ : F ⟶ G} (ho : homotopy φ₁ φ₂) : cochain F G (-1) :=
cochain.mk (λ p q hpq, ho.hom p q)

@[simp, reassoc]
lemma v_comp_X_iso_of_eq_hom {K L : cochain_complex C ℤ} {n : ℤ}
  (γ : cochain K L n) (p q q' : ℤ)
  (hpq : q = p + n) (hq' : q = q'):
  γ.v p q hpq ≫ (homological_complex.X_iso_of_eq L hq').hom = γ.v p q' (by rw [← hq', hpq]) :=
by { subst hq', simp only [homological_complex.X_iso_of_eq_refl, iso.refl_hom, comp_id], }

def comp {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (h : n₁₂ = n₁ + n₂) :
  cochain F K n₁₂ :=
cochain.mk (λ p q hpq, z₁.v p (p+n₁) rfl ≫ z₂.v (p+n₁) q (by linarith))

notation a ` ≫[`:81 b `] ` c:80 := cochain.comp a c b

lemma comp_v {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (h : n₁₂ = n₁+n₂)
  (p₁ p₂ p₃ : ℤ) (h₁ : p₂=p₁+n₁) (h₂ : p₃=p₂+n₂) :
  (comp z₁ z₂ h).v p₁ p₃ (by rw [h₂, h₁, h, add_assoc]) =
  z₁.v p₁ p₂ h₁ ≫ z₂.v p₂ p₃ h₂ := by { subst h₁, refl,}

@[simp]
lemma zero_comp {n₁ n₂ n₁₂ : ℤ} (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp (0 : cochain F G n₁) z₂ h = 0 :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [zero_comp],
end

@[simp]
lemma add_comp {n₁ n₂ n₁₂ : ℤ} (z₁ z₁' : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp (z₁+z₁') z₂ h = comp z₁ z₂ h + comp z₁' z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [add_comp],
end

@[simp]
lemma sub_comp {n₁ n₂ n₁₂ : ℤ} (z₁ z₁' : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp (z₁-z₁') z₂ h = comp z₁ z₂ h - comp z₁' z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [sub_comp],
end

@[simp]
lemma neg_comp {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp (-z₁) z₂ h = -comp z₁ z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [neg_comp],
end

@[simp]
lemma zsmul_comp {n₁ n₂ n₁₂ : ℤ} (k : ℤ) (z₁ : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp (k • z₁) z₂ h = k • comp z₁ z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [zsmul_comp],
end

@[simp]
lemma zero_cochain_comp {n : ℤ} (z₁ : cochain F G 0) (z₂ : cochain G K n)
  (p q : ℤ) (hpq : q=p+n) :
  (cochain.comp z₁ z₂ (zero_add n).symm).v p q hpq =
    z₁.v p p (add_zero p).symm ≫ z₂.v p q hpq :=
comp_v z₁ z₂ (zero_add n).symm p p q (add_zero p).symm hpq

lemma zero_cochain_comp' {n : ℤ} (z₁ : cochain F G 0) (z₂ : cochain G K n)
  (p₁ p₂ p₃ : ℤ) (h₁₂ : p₂=p₁+0) (h₂₃ : p₃=p₂+n) :
  (z₁.v p₁ p₂ h₁₂ ≫ z₂.v p₂ p₃ h₂₃ : F.X p₁ ⟶ K.X p₃) =
  z₁.v p₁ p₁ (add_zero p₁).symm ≫ z₂.v p₁ p₃ (show p₃ = p₁+n, by rw [h₂₃, h₁₂, add_zero]) :=
by { rw add_zero at h₁₂, subst h₁₂, }

@[simp]
lemma id_comp {n : ℤ} (z₂ : cochain F G n) :
  cochain.comp (cochain.of_hom (𝟙 F)) z₂ (zero_add n).symm = z₂ :=
begin
  ext,
  simp only [zero_cochain_comp, of_hom_v, homological_complex.id_f, id_comp],
end

@[simp]
lemma comp_zero {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁)
  (h : n₁₂ = n₁ + n₂) : comp z₁ (0 : cochain G K n₂) h = 0 :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [comp_zero],
end

@[simp]
lemma comp_add {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ z₂' : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp z₁ (z₂+z₂') h = comp z₁ z₂ h + comp z₁ z₂' h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [comp_add],
end

@[simp]
lemma comp_sub {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ z₂' : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp z₁ (z₂-z₂') h = comp z₁ z₂ h - comp z₁ z₂' h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [comp_sub],
end

@[simp]
lemma comp_neg {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp z₁ (-z₂) h = -comp z₁ z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [comp_neg],
end

@[simp]
lemma comp_zsmul {n₁ n₂ n₁₂ : ℤ} (k : ℤ) (z₁ : cochain F G n₁) (z₂ : cochain G K n₂)
  (h : n₁₂ = n₁ + n₂) : comp z₁ (k • z₂) h = k • comp z₁ z₂ h :=
begin
  ext,
  dsimp [comp, mk, v],
  simp only [comp_zsmul],
end

@[simp]
lemma comp_zero_cochain (z₁ : cochain F G n) (z₂ : cochain G K 0)
  (p q : ℤ) (hpq : q=p+n) :
  (cochain.comp z₁ z₂ (add_zero n).symm).v p q hpq =
    z₁.v p q hpq ≫ z₂.v q q (add_zero q).symm :=
comp_v z₁ z₂ (add_zero n).symm p q q hpq (add_zero q).symm

lemma comp_zero_cochain' (z₁ : cochain F G n) (z₂ : cochain G K 0)
  (p₁ p₂ p₃ : ℤ) (h₁₂ : p₂=p₁+n) (h₂₃ : p₃=p₂+0) :
  (z₁.v p₁ p₂ h₁₂ ≫ z₂.v p₂ p₃ h₂₃ : F.X p₁ ⟶ K.X p₃) =
  z₁.v p₁ p₃ (show p₃=p₁+n, by rw [h₂₃, h₁₂, add_zero]) ≫ z₂.v p₃ p₃ (add_zero p₃).symm :=
by { rw add_zero at h₂₃, subst h₂₃, }

@[simp]
lemma comp_id {n : ℤ} (z₁ : cochain F G n) :
  cochain.comp z₁ (cochain.of_hom (𝟙 G)) (add_zero n).symm = z₁ :=
begin
  ext,
  simp only [comp_zero_cochain, of_hom_v, homological_complex.id_f, comp_id],
end

@[simp]
lemma of_homs_comp (φ : Π (p : ℤ), F.X p ⟶ G.X p) (ψ : Π (p : ℤ), G.X p ⟶ K.X p) :
  cochain.comp (of_homs φ) (of_homs ψ) (zero_add 0).symm = of_homs (λ p, φ p ≫ ψ p) :=
begin
  ext,
  simp only [comp_zero_cochain, of_homs_v],
end

@[simp]
lemma of_hom_comp (f : F ⟶ G) (g : G ⟶ K) :
  of_hom (f ≫ g) = cochain.comp (of_hom f) (of_hom g) (zero_add 0).symm :=
by simpa only [of_hom, of_homs_comp]

lemma comp_assoc {n₁ n₂ n₃ n₁₂ n₂₃ n₁₂₃ : ℤ}
  (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (z₃ : cochain K L n₃)
  (h₁₂ : n₁₂ = n₁ + n₂) (h₂₃ : n₂₃ = n₂ + n₃) (h₁₂₃ : n₁₂₃ = n₁ + n₂ + n₃) :
  cochain.comp (cochain.comp z₁ z₂ h₁₂) z₃ (show n₁₂₃ = n₁₂ + n₃, by rw [h₁₂, h₁₂₃]) =
    cochain.comp z₁ (cochain.comp z₂ z₃ h₂₃)
      (show n₁₂₃ = n₁ + n₂₃, by rw [h₂₃, h₁₂₃, add_assoc]) :=
begin
  ext,
  simp only [comp_v _ _ (show n₁₂₃ = n₁₂ + n₃, by rw [h₁₂, h₁₂₃]) p (p+n₁₂) q rfl (by linarith),
    comp_v _ _ h₁₂ p (p+n₁) (p+n₁₂) rfl (by linarith),
    comp_v z₁ (cochain.comp z₂ z₃ h₂₃) (show n₁₂₃ = n₁ + n₂₃, by linarith)
      p (p+n₁) q rfl (by linarith),
    comp_v _ _ h₂₃ (p+n₁) (p+n₁₂) q (by linarith) (by linarith), assoc],
end

@[simp]
lemma comp_assoc_of_first_is_zero_cochain {n₂ n₃ n₂₃ : ℤ}
  (z₁ : cochain F G 0) (z₂ : cochain G K n₂) (z₃ : cochain K L n₃)
  (h₂₃ : n₂₃ = n₂ + n₃) :
  cochain.comp (cochain.comp z₁ z₂ (zero_add n₂).symm) z₃ h₂₃ =
    cochain.comp z₁ (cochain.comp z₂ z₃ h₂₃)
      (zero_add n₂₃).symm :=
comp_assoc z₁ z₂ z₃ (zero_add n₂).symm h₂₃ (by linarith)

@[simp]
lemma comp_assoc_of_second_is_zero_cochain {n₁ n₃ n₁₃ : ℤ}
  (z₁ : cochain F G n₁) (z₂ : cochain G K 0) (z₃ : cochain K L n₃) (h₁₃ : n₁₃ = n₁ + n₃) :
  cochain.comp (cochain.comp z₁ z₂ (add_zero n₁).symm) z₃ h₁₃ =
    cochain.comp z₁ (cochain.comp z₂ z₃ (zero_add n₃).symm) h₁₃ :=
comp_assoc z₁ z₂ z₃ (add_zero n₁).symm (zero_add n₃).symm (by linarith)

@[simp]
lemma comp_assoc_of_third_is_zero_cochain {n₁ n₂ n₁₂ : ℤ}
  (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (z₃ : cochain K L 0) (h₁₂ : n₁₂ = n₁ + n₂) :
  cochain.comp (cochain.comp z₁ z₂ h₁₂) z₃ (add_zero n₁₂).symm =
    cochain.comp z₁ (cochain.comp z₂ z₃ (add_zero n₂).symm) h₁₂ :=
comp_assoc z₁ z₂ z₃ h₁₂ (add_zero n₂).symm (by linarith)

variable (K)

def of_d : cochain K K 1 := cochain.mk (λ p q hpq, K.d p q)

@[simp]
lemma of_d_v (p q : ℤ) (hpq : q=p+1) :
  (of_d K).v p q hpq = K.d p q := rfl

end cochain

/- Differentials -/

variables {F G} (n)

def δ (z : cochain F G n) : cochain F G m :=
cochain.mk (λ (p q : ℤ) hpq, z.v p (p+n) rfl ≫ G.d (p+n) q +
  ε (n+1) • F.d p (p+m-n) ≫ z.v (p+m-n) q (by { dsimp [int.sub], linarith}))

lemma δ_v (hnm : n+1=m) (z : cochain F G n) (p q : ℤ) (hpq : q=p+m) (q₁ q₂ : ℤ)
  (hq₁ : q₁=q-1) (hq₂ : q₂=p+1) : (δ n m z).v p q hpq =
  z.v p q₁ (by {rw [hq₁, hpq, ← hnm, ← add_assoc, add_tsub_cancel_right],}) ≫ G.d q₁ q
  + ε (n+1) • F.d p q₂ ≫ z.v q₂ q (by rw [hpq, hq₂, ← hnm, add_comm n, add_assoc]) :=
begin
  have h₁ : q₁ = p+n := by linarith,
  have h₂ : q₂ = p+m-n := by linarith,
  substs h₁ h₂,
  refl,
end

lemma δ_shape (hnm : ¬ n+1=m) (z : cochain F G n) : δ n m z = 0 :=
begin
  ext,
  dsimp [δ, cochain.mk, cochain.v],
  rw [F.shape, G.shape, limits.comp_zero, limits.zero_comp, smul_zero, add_zero],
  all_goals
  { change ¬ _=_ ,
    intro h,
    apply hnm,
    linarith, },
end

variables (F G)

def δ_hom : cochain F G n →+ cochain F G m :=
{ to_fun := δ n m,
  map_zero' := begin
    ext,
    dsimp [δ, cochain.mk, cochain.v],
    simp only [limits.zero_comp, limits.comp_zero, smul_zero, add_zero],
  end,
  map_add' := λ z₁ z₂, begin
    ext,
    dsimp [δ, cochain.mk, cochain.v],
    simp only [preadditive.add_comp, preadditive.comp_add, smul_add],
    abel,
  end}

variables {F G}

@[simp]
lemma δ_add (z₁ z₂ : cochain F G n) : δ n m (z₁ + z₂) = δ n m z₁ + δ n m z₂ :=
(δ_hom F G n m).map_add z₁ z₂

@[simp]
lemma δ_sub (z₁ z₂ : cochain F G n) : δ n m (z₁ - z₂) = δ n m z₁ - δ n m z₂ :=
(δ_hom F G n m).map_sub z₁ z₂

@[simp]
lemma δ_zero : δ n m (0 : cochain F G n) = 0 := (δ_hom F G n m).map_zero

@[simp]
lemma δ_neg (z : cochain F G n) : δ n m (-z) = - δ n m z :=
(δ_hom F G n m).map_neg z

@[simp]
lemma δ_zsmul (k : ℤ) (z : cochain F G n) : δ n m (k • z) = k • δ n m z :=
(δ_hom F G n m).map_zsmul z k

@[simp]
lemma δδ (n₀ n₁ n₂ : ℤ) (z : cochain F G n₀) : δ n₁ n₂ (δ n₀ n₁ z) = 0 :=
begin
  by_cases h₀₁ : n₀+1 = n₁, swap,
  { rw [δ_shape n₀ n₁ h₀₁, δ_zero], },
  by_cases h₁₂ : n₁+1 = n₂, swap,
  { rw [δ_shape n₁ n₂ h₁₂], },
  ext,
  rw δ_v n₁ n₂ h₁₂ _ p q hpq _ _ rfl rfl,
  rw δ_v n₀ n₁ h₀₁ z p (q-1) (by linarith) (q-2) _ (by linarith) rfl,
  rw δ_v n₀ n₁ h₀₁ z (p+1) q (by linarith) _ (p+2) rfl (by linarith),
  simp only [← h₀₁, ε_succ, add_comp, neg_neg, neg_zsmul, neg_comp, cochain.zero_v,
    zsmul_comp, comp_zsmul, comp_add, comp_neg, assoc, homological_complex.d_comp_d,
    homological_complex.d_comp_d_assoc, comp_zero, zero_comp, zsmul_zero, neg_zero, add_zero,
    zero_add, add_left_neg],
end

lemma δ_comp {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (h : n₁₂ = n₁ + n₂)
  (m₁ m₂ m₁₂ : ℤ) (h₁₂ : n₁₂+1 = m₁₂) (h₁ : n₁+1 = m₁) (h₂ : n₂+1 = m₂) :
δ n₁₂ m₁₂ (cochain.comp z₁ z₂ h) = cochain.comp z₁ (δ n₂ m₂ z₂) (by linarith) + ε n₂ • cochain.comp (δ n₁ m₁ z₁) z₂ (by linarith) :=
begin
  substs h₁₂ h₁ h₂,
  ext,
  have eq : ε (n₁₂ + 1) = ε n₂ * ε (n₁+1),
  { rw ← ε_add, congr' 1, linarith, },
  simp only [cochain.add_v, cochain.zsmul_v,
    cochain.comp_v z₁ (δ n₂ (n₂+1) z₂) (show n₁₂+1=n₁+(n₂+1), by linarith) p _ q rfl (by linarith),
    cochain.comp_v (δ n₁ (n₁+1) z₁) z₂ (show n₁₂+1=_, by linarith) p (p+n₁+1) q (by linarith) (by linarith),
    cochain.comp_v z₁ z₂ h p (p+n₁) (p+n₁₂) rfl (by linarith),
    cochain.comp_v z₁ z₂ h (p+1) (p+n₁+1) q (by linarith) (by linarith),
    δ_v n₁₂ _ rfl (cochain.comp z₁ z₂ h) p q hpq (p+n₁₂) _ (by linarith) rfl,
    δ_v n₁ (n₁+1) rfl z₁ p (p+n₁+1) (by linarith) (p+n₁) (p+1) (by linarith) rfl,
    δ_v n₂ (n₂+1) rfl z₂ (p+n₁) q (by linarith) (p+n₁₂) (p+n₁+1) (by linarith) rfl,
    assoc, comp_add, comp_zsmul, zsmul_add, add_comp, zsmul_comp, smul_smul, eq,
    ε_add n₂ 1, ε_1, mul_neg, mul_one, neg_zsmul, comp_neg, ← add_assoc],
  suffices : ∀ (a b c : F.X p ⟶ K.X q), a+b=a+(-c)+c+b,
  { apply this, },
  intros a b c,
  abel,
end

@[simp]
lemma δ_comp_of_first_is_zero_cochain {n₂ : ℤ} (z₁ : cochain F G 0) (z₂ : cochain G K n₂)
  (m₂ : ℤ) (h₂ : n₂+1 = m₂) :
δ n₂ m₂ (cochain.comp z₁ z₂ (zero_add n₂).symm) =
  cochain.comp z₁ (δ n₂ m₂ z₂) (by linarith) + ε n₂ • cochain.comp (δ 0 1 z₁) z₂ (by linarith) :=
δ_comp z₁ z₂ (zero_add n₂).symm 1 m₂ m₂ h₂ (zero_add 1) h₂

@[simp]
lemma δ_comp_of_second_is_zero_cochain {n₁ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K 0)
  (m₁ : ℤ) (h₁ : n₁+1 = m₁) : δ n₁ m₁ (cochain.comp z₁ z₂ (add_zero n₁).symm) =
  cochain.comp z₁ (δ 0 1 z₂) h₁.symm + cochain.comp (δ n₁ m₁ z₁) z₂ (add_zero m₁).symm :=
by simp only [δ_comp z₁ z₂ (add_zero n₁).symm m₁ 1 m₁ h₁ h₁ (zero_add 1), ε_0, one_zsmul]

end hom_complex

variables (F G)

open hom_complex

def hom_complex : cochain_complex AddCommGroup ℤ :=
{ X := λ i, AddCommGroup.of (cochain F G i),
  d := λ i j, AddCommGroup.of_hom (δ_hom F G i j),
  shape' := λ i j hij, by { ext1 z, exact δ_shape i j hij z, },
  d_comp_d' := λ i j k hij hjk, by { ext1 f, apply δδ, } }

namespace hom_complex

def cocycle : add_subgroup (cochain F G n) :=
add_monoid_hom.ker ((hom_complex F G).d n (n+1))

namespace cocycle

variables {F G}

lemma mem_iff (hnm : n+1=m) (z : cochain F G n) :
  z ∈ cocycle F G n ↔ δ n m z = 0 :=
by { subst hnm, refl, }

variable {n}

@[simps]
def mk (z : cochain F G n) (m : ℤ) (hnm : n+1 = m) (h : δ n m z = 0) : cocycle F G n :=
⟨z, by simpa only [mem_iff n m hnm z] using h⟩

@[simp]
lemma δ_eq_zero {n : ℤ} (z : cocycle F G n) (m : ℤ) : δ n m (z : cochain F G n) = 0 :=
begin
  by_cases n+1=m,
  { rw ← mem_iff n m h,
    exact z.2, },
  { apply δ_shape n m h, }
end

@[simps]
def of_hom (φ : F ⟶ G) : cocycle F G 0 := mk (cochain.of_hom φ) 1 (zero_add 1)
begin
  ext,
  simp only [δ_v 0 1 (zero_add 1) _ p q hpq p q (by linarith) hpq,
    cochain.of_hom_v, homological_complex.hom.comm, ε_1, neg_smul, one_zsmul,
    add_right_neg, cochain.zero_v, zero_add],
end

@[simp]
lemma δ_cochain_of_hom (φ : F ⟶ G) : δ 0 1 (cochain.of_hom φ) = 0 :=
by apply δ_eq_zero (of_hom φ)

@[simps]
def hom_of (z : cocycle F G 0) : F ⟶ G :=
{ f := λ i, (z : cochain F G 0).v i i (add_zero i).symm,
  comm' := λ i j hij, begin
    change i+1=j at hij,
    have hz₁ := z.2,
    rw mem_iff 0 1 (zero_add 1) at hz₁,
    simpa only [δ_v 0 1 (zero_add 1) z.1 i j hij.symm i j (by linarith) hij.symm,
      zero_add, ε_1, neg_smul, one_zsmul, cochain.zero_v, add_neg_eq_zero]
      using cochain.congr_v hz₁ i j hij.symm,
  end, }

@[simp]
lemma hom_of_of_hom_eq_self (φ : F ⟶ G) : hom_of (of_hom φ) = φ :=
by { ext i, simp only [of_hom, hom_of_f, mk_coe, cochain.of_hom_v], }

@[simp]
lemma of_hom_hom_of_eq_self (z : cocycle F G 0) : of_hom (hom_of z) = z :=
begin
  ext,
  simp only [of_hom, mk_coe, cochain.of_hom_v, hom_of_f],
end

@[simp]
lemma cochain_of_hom_hom_of_eq_coe (z : cocycle F G 0) :
  (cochain.of_hom (hom_of z) : cochain F G 0) = (z : cochain F G 0) :=
by simpa only [subtype.ext_iff] using of_hom_hom_of_eq_self z

variables (F G)

@[simps]
def equiv_hom : (F ⟶ G) ≃+ cocycle F G 0 :=
{ to_fun := of_hom,
  inv_fun := hom_of,
  left_inv := hom_of_of_hom_eq_self,
  right_inv := of_hom_hom_of_eq_self,
  map_add' := λ φ₁ φ₂, begin
    ext,
    simp only [of_hom, cochain.of_hom, cochain.of_homs, cochain.mk, cochain.v,
      homological_complex.add_f_apply, mk_coe, eq_to_hom_refl, comp_id,
      add_subgroup.coe_add, pi.add_apply],
  end, }

def of_d : cocycle K K 1 :=
cocycle.mk (cochain.of_d K) 2 rfl begin
  ext p q hpq,
  simp only [δ_v 1 2 rfl _ p q hpq _ _ rfl rfl, cochain.of_d_v,
    homological_complex.d_comp_d, smul_zero, add_zero, cochain.zero_v],
end

end cocycle

namespace cochain

variables {F G}

lemma of_hom_injective {f₁ f₂ : F ⟶ G} (h : of_hom f₁ = of_hom f₂) : f₁ = f₂ :=
begin
  rw [← cocycle.hom_of_of_hom_eq_self f₁, ← cocycle.hom_of_of_hom_eq_self f₂],
  congr' 1,
  ext1,
  simpa only [cocycle.of_hom_coe] using h,
end

end cochain

variables {F G}

@[simps]
def equiv_homotopy (φ₁ φ₂ : F ⟶ G) :
  homotopy φ₁ φ₂ ≃
    { z : cochain F G (-1) // cochain.of_hom φ₁ = δ (-1) 0 z + cochain.of_hom φ₂ } :=
{ to_fun := λ ho, begin
    refine ⟨cochain.of_homotopy ho, _⟩,
    ext,
    have comm := ho.comm p,
    rw [d_next_eq ho.hom rfl, prev_d_eq ho.hom (sub_add_cancel p 1)] at comm,
    rw [cochain.add_v, δ_v (-1) 0 (neg_add_self 1) _ p p (add_zero p).symm _ _ rfl rfl],
    simp only [δ_v (-1) 0 (neg_add_self 1) _ p p (add_zero p).symm _ _ rfl rfl,
      add_left_neg, ε_0, one_zsmul, cochain.mk, cochain.of_hom_v, cochain.v,
      cochain.of_homotopy, cochain.of_hom_v],
    dsimp only,
    suffices : ∀ (a b c d : F.X p ⟶ G.X p) (h : a = b+c+d), a=c+b+d,
    { exact this _ _ _ _ comm, },
    { intros a b c d h, rw h, abel, },
  end,
  inv_fun := λ z,
    { hom := λ i j, begin
        by_cases j+1=i,
        { exact (z : cochain F G (-1)).v i j (by linarith), },
        { exact 0, },
      end,
      zero' := λ i j hij, begin
        change ¬ j+1 = i at hij,
        rw dif_neg hij,
      end,
      comm := λ p, begin
        have h₁ : p+1 = p+1 := rfl,
        have h₂ : p-1+1 = p := by linarith,
        have h₁' : (complex_shape.up ℤ).rel p (p+1) := h₁,
        have h₂' : (complex_shape.up ℤ).rel (p-1) p := h₂,
        rw [d_next_eq _ h₁', prev_d_eq _ h₂', dif_pos h₁, dif_pos h₂],
        have hz := cochain.congr_v z.2 p p (add_zero p).symm,
        simp only [cochain.add_v, δ_v (-1) 0 (neg_add_self 1) _ p p (add_zero p).symm _ _ rfl rfl,
          cochain.of_hom_v, add_left_neg, ε_0, one_zsmul] at hz,
        suffices : ∀ (a b c d : F.X p ⟶ G.X p) (h : a = b+c+d), a=c+b+d,
        { exact this _ _ _ _ hz, },
        { intros a b c d h, rw h, abel, },
      end, },
  left_inv := λ ho, begin
    ext i j,
    dsimp,
    split_ifs,
    { refl, },
    { rw ho.zero i j h, },
  end,
  right_inv := λ z, begin
    ext,
    dsimp [cochain.mk, cochain.v],
    simpa only [dif_pos (show q+1=p, by linarith)],
  end, }

lemma δ_cochain_of_homotopy {φ₁ φ₂ : F ⟶ G} (h : homotopy φ₁ φ₂) :
  δ (-1) 0 (cochain.of_homotopy h) = cochain.of_hom φ₁ - cochain.of_hom φ₂ :=
by rw [((equiv_homotopy _ _) h).2, add_sub_cancel,
  subtype.val_eq_coe, equiv_homotopy_apply_coe]

namespace cochain

variable {n}

def lift_to_kernel' (z : cochain L G n) {i : F ⟶ G} {f : G ⟶ K} (hip : is_termwise_kernel i f)
  (hz : cochain.comp z (of_hom f) (add_zero n).symm = 0) (p q : ℤ) (hpq : q=p+n):=
kernel_fork.is_limit.lift' (hip.is_limit q) (z.v p q hpq)
(by simpa only [comp_zero_cochain, of_hom_v] using congr_v hz p q hpq)

def lift_to_kernel (z : cochain L G n) {i : F ⟶ G} {f : G ⟶ K} (hip : is_termwise_kernel i f)
  (hz : cochain.comp z (of_hom f) (add_zero n).symm = 0) : cochain L F n :=
cochain.mk (λ p q hpq, (lift_to_kernel' z hip hz p q hpq).1)

@[simp]
lemma lift_to_kernel_comp (z : cochain L G n) {i : F ⟶ G} {f : G ⟶ K} (hip : is_termwise_kernel i f)
  (hz : cochain.comp z (of_hom f) (add_zero n).symm = 0) :
  cochain.comp (z.lift_to_kernel hip hz) (cochain.of_hom i) (add_zero n).symm = z :=
begin
  ext,
  simpa only [comp_v _ _ (add_zero n).symm p q q hpq (add_zero q).symm,
    of_hom_v] using (lift_to_kernel' z hip hz p q hpq).2,
end

end cochain

namespace cocycle

variable {n}

def lift_to_kernel (z : cocycle L G n) {i : F ⟶ G} {f : G ⟶ K} (hip : is_termwise_kernel i f)
  (hz : cochain.comp (z : cochain L G n) (cochain.of_hom f) (add_zero n).symm = 0) :
  cocycle L F n :=
cocycle.mk (cochain.lift_to_kernel (z : cochain L G n) hip hz) _ rfl
begin
  suffices : δ n (n + 1) (cochain.comp
    ((z : cochain L G n).lift_to_kernel hip hz) (cochain.of_hom i) (add_zero n).symm) = 0,
  { ext,
    haveI : mono (i.f q) := hip.termwise_mono q,
    simpa only [← cancel_mono (i.f q), cochain.zero_v, zero_comp,
      δ_comp_of_second_is_zero_cochain, δ_cochain_of_hom,
      cochain.comp_zero, zero_add, cochain.comp_zero_cochain,
      cochain.of_hom_v, cochain.zero_v] using cochain.congr_v this p q hpq, },
  simp only [cochain.lift_to_kernel_comp, δ_eq_zero],
end

lemma lift_to_kernel_comp (z : cocycle L G n) {i : F ⟶ G} {f : G ⟶ K} (hip : is_termwise_kernel i f)
  (hz : cochain.comp (z : cochain L G n) (cochain.of_hom f) (add_zero n).symm = 0) :
  cochain.comp (lift_to_kernel z hip hz : cochain L F n) (cochain.of_hom i) (add_zero n).symm =
  (z : cochain L G n) := by apply cochain.lift_to_kernel_comp

end cocycle

section

variables {n} {D : Type*} [category D] [preadditive D] (z z' : cochain K L n) (f : K ⟶ L)
  (Φ : C ⥤ D) [functor.additive Φ]

namespace cochain

def map : cochain ((functor.map_homological_complex Φ _).obj K)
  ((functor.map_homological_complex Φ _).obj L) n :=
cochain.mk (λ p q hpq, Φ.map (z.v p q hpq))

@[simp]
lemma map_v (p q : ℤ) (hpq : q=p+n) :
  (z.map Φ).v p q hpq = Φ.map (z.v p q hpq) := rfl

@[simp]
lemma map_add : (z+z').map Φ = z.map Φ + z'.map Φ := by tidy

@[simp]
lemma map_neg : (-z).map Φ = -z.map Φ := by tidy

@[simp]
lemma map_sub : (z-z').map Φ = z.map Φ - z'.map Φ := by tidy

variables (K L n)

@[simp]
lemma map_zero : (0 : cochain K L n).map Φ = 0 := by tidy

@[simp]
lemma map_comp {n₁ n₂ n₁₂ : ℤ} (z₁ : cochain F G n₁) (z₂ : cochain G K n₂) (h : n₁₂ = n₁ + n₂)
  (Φ : C ⥤ D) [functor.additive Φ] :
  (z₁.comp z₂ h).map Φ = (z₁.map Φ).comp (z₂.map Φ) h :=
begin
  ext p q hpq,
  simp only [map_v, comp_v _ _ h p _ q rfl (by linarith), Φ.map_comp],
end

@[simp]
lemma map_of_hom : (cochain.of_hom f).map Φ =
  cochain.of_hom ((Φ.map_homological_complex _).map f) := by tidy

end cochain

variables (n m)

@[simp]
lemma δ_map : δ n m (z.map Φ) = (δ n m z).map Φ :=
begin
  by_cases hnm : n+1=m,
  { ext p q hpq,
    simp only [δ_v n m hnm _ p q hpq (q-1) (p+1) rfl rfl, cochain.map_v],
    simp only [functor.map_homological_complex_obj_d, ε_succ, neg_smul, functor.map_add,
      functor.map_comp, functor.map_neg, add_right_inj, neg_inj, Φ.map_zsmul], },
  { simp only [δ_shape _ _ hnm, cochain.map_zero], },
end

end

namespace cocycle

variables {n} {D : Type*} [category D] [preadditive D] (z z' : cocycle K L n) (f : K ⟶ L)
  (Φ : C ⥤ D) [functor.additive Φ]

@[simps]
def map : cocycle ((functor.map_homological_complex Φ _).obj K)
  ((functor.map_homological_complex Φ _).obj L) n :=
cocycle.mk ((z : cochain K L n).map Φ) (n+1) rfl (by simp)

@[simp]
lemma map_add : cocycle.map (z+z') Φ = cocycle.map z Φ + cocycle.map z' Φ :=
by { ext1, simp, }

@[simp]
lemma map_neg : cocycle.map (-z) Φ = -cocycle.map z Φ :=
by { ext1, simp, }

@[simp]
lemma map_sub : cocycle.map (z-z') Φ = cocycle.map z Φ - cocycle.map z' Φ :=
by { ext1, simp, }

@[simp]
lemma map_of_hom : cocycle.map (cocycle.of_hom f) Φ =
  cocycle.of_hom ((Φ.map_homological_complex _).map f) := by tidy

variables (K L n)

@[simp]
lemma map_zero : cocycle.map (0 : cocycle K L n) Φ = 0 :=
by { ext1, simp, }

end cocycle

end hom_complex

end cochain_complex


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.PostPort

universes u v w

namespace Mathlib

namespace list

namespace func

/- Definitions for using lists as finite
   representations of functions with domain ℕ. -/

def neg {α : Type u} [Neg α] (as : List α) : List α :=
  map (fun (a : α) => -a) as

@[simp] def set {α : Type u} [Inhabited α] (a : α) : List α → ℕ → List α :=
  sorry

@[simp] def get {α : Type u} [Inhabited α] : ℕ → List α → α :=
  sorry

def equiv {α : Type u} [Inhabited α] (as1 : List α) (as2 : List α) :=
  ∀ (m : ℕ), get m as1 = get m as2

@[simp] def pointwise {α : Type u} {β : Type v} {γ : Type w} [Inhabited α] [Inhabited β] (f : α → β → γ) : List α → List β → List γ :=
  sorry

def add {α : Type u} [HasZero α] [Add α] : List α → List α → List α :=
  pointwise Add.add

def sub {α : Type u} [HasZero α] [Sub α] : List α → List α → List α :=
  pointwise Sub.sub

/- set -/

theorem length_set {α : Type u} {a : α} [Inhabited α] {m : ℕ} {as : List α} : length (set a as m) = max (length as) (m + 1) := sorry

@[simp] theorem get_nil {α : Type u} [Inhabited α] {k : ℕ} : get k [] = Inhabited.default :=
  nat.cases_on k (Eq.refl (get 0 [])) fun (k : ℕ) => Eq.refl (get (Nat.succ k) [])

theorem get_eq_default_of_le {α : Type u} [Inhabited α] (k : ℕ) {as : List α} : length as ≤ k → get k as = Inhabited.default := sorry

@[simp] theorem get_set {α : Type u} [Inhabited α] {a : α} {k : ℕ} {as : List α} : get k (set a as k) = a := sorry

theorem eq_get_of_mem {α : Type u} [Inhabited α] {a : α} {as : List α} : a ∈ as → ∃ (n : ℕ), α → a = get n as := sorry

theorem mem_get_of_le {α : Type u} [Inhabited α] {n : ℕ} {as : List α} : n < length as → get n as ∈ as := sorry

theorem mem_get_of_ne_zero {α : Type u} [Inhabited α] {n : ℕ} {as : List α} : get n as ≠ Inhabited.default → get n as ∈ as := sorry

theorem get_set_eq_of_ne {α : Type u} [Inhabited α] {a : α} {as : List α} (k : ℕ) (m : ℕ) : m ≠ k → get m (set a as k) = get m as := sorry

theorem get_map {α : Type u} {β : Type v} [Inhabited α] [Inhabited β] {f : α → β} {n : ℕ} {as : List α} : n < length as → get n (map f as) = f (get n as) := sorry

theorem get_map' {α : Type u} {β : Type v} [Inhabited α] [Inhabited β] {f : α → β} {n : ℕ} {as : List α} : f Inhabited.default = Inhabited.default → get n (map f as) = f (get n as) := sorry

theorem forall_val_of_forall_mem {α : Type u} [Inhabited α] {as : List α} {p : α → Prop} : p Inhabited.default → (∀ (x : α), x ∈ as → p x) → ∀ (n : ℕ), p (get n as) := sorry

/- equiv -/

theorem equiv_refl {α : Type u} {as : List α} [Inhabited α] : equiv as as :=
  fun (k : ℕ) => rfl

theorem equiv_symm {α : Type u} {as1 : List α} {as2 : List α} [Inhabited α] : equiv as1 as2 → equiv as2 as1 :=
  fun (h1 : equiv as1 as2) (k : ℕ) => Eq.symm (h1 k)

theorem equiv_trans {α : Type u} {as1 : List α} {as2 : List α} {as3 : List α} [Inhabited α] : equiv as1 as2 → equiv as2 as3 → equiv as1 as3 :=
  fun (h1 : equiv as1 as2) (h2 : equiv as2 as3) (k : ℕ) => Eq.trans (h1 k) (h2 k)

theorem equiv_of_eq {α : Type u} {as1 : List α} {as2 : List α} [Inhabited α] : as1 = as2 → equiv as1 as2 :=
  fun (h1 : as1 = as2) => eq.mpr (id (Eq._oldrec (Eq.refl (equiv as1 as2)) h1)) equiv_refl

theorem eq_of_equiv {α : Type u} [Inhabited α] {as1 : List α} {as2 : List α} : length as1 = length as2 → equiv as1 as2 → as1 = as2 := sorry

end func

-- We want to drop the `inhabited` instances for a moment,

-- so we close and open the namespace

namespace func

/- neg -/

@[simp] theorem get_neg {α : Type u} [add_group α] {k : ℕ} {as : List α} : get k (neg as) = -get k as := sorry

@[simp] theorem length_neg {α : Type u} [Neg α] (as : List α) : length (neg as) = length as := sorry

/- pointwise -/

theorem nil_pointwise {α : Type u} {β : Type v} {γ : Type w} [Inhabited α] [Inhabited β] {f : α → β → γ} (bs : List β) : pointwise f [] bs = map (f Inhabited.default) bs := sorry

theorem pointwise_nil {α : Type u} {β : Type v} {γ : Type w} [Inhabited α] [Inhabited β] {f : α → β → γ} (as : List α) : pointwise f as [] = map (fun (a : α) => f a Inhabited.default) as := sorry

theorem get_pointwise {α : Type u} {β : Type v} {γ : Type w} [Inhabited α] [Inhabited β] [Inhabited γ] {f : α → β → γ} (h1 : f Inhabited.default Inhabited.default = Inhabited.default) (k : ℕ) (as : List α) (bs : List β) : get k (pointwise f as bs) = f (get k as) (get k bs) := sorry

theorem length_pointwise {α : Type u} {β : Type v} {γ : Type w} [Inhabited α] [Inhabited β] {f : α → β → γ} {as : List α} {bs : List β} : length (pointwise f as bs) = max (length as) (length bs) := sorry

end func

namespace func

/- add -/

@[simp] theorem get_add {α : Type u} [add_monoid α] {k : ℕ} {xs : List α} {ys : List α} : get k (add xs ys) = get k xs + get k ys :=
  get_pointwise (zero_add Inhabited.default) k xs ys

@[simp] theorem length_add {α : Type u} [HasZero α] [Add α] {xs : List α} {ys : List α} : length (add xs ys) = max (length xs) (length ys) :=
  length_pointwise

@[simp] theorem nil_add {α : Type u} [add_monoid α] (as : List α) : add [] as = as := sorry

@[simp] theorem add_nil {α : Type u} [add_monoid α] (as : List α) : add as [] = as := sorry

theorem map_add_map {α : Type u} [add_monoid α] (f : α → α) (g : α → α) {as : List α} : add (map f as) (map g as) = map (fun (x : α) => f x + g x) as := sorry

/- sub -/

@[simp] theorem get_sub {α : Type u} [add_group α] {k : ℕ} {xs : List α} {ys : List α} : get k (sub xs ys) = get k xs - get k ys :=
  get_pointwise (sub_zero Inhabited.default) k xs ys

@[simp] theorem length_sub {α : Type u} [HasZero α] [Sub α] {xs : List α} {ys : List α} : length (sub xs ys) = max (length xs) (length ys) :=
  length_pointwise

@[simp] theorem nil_sub {α : Type} [add_group α] (as : List α) : sub [] as = neg as := sorry

@[simp] theorem sub_nil {α : Type} [add_group α] (as : List α) : sub as [] = as := sorry


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.invertible
import Mathlib.linear_algebra.affine_space.affine_equiv
import Mathlib.PostPort

universes u_1 u_2 u_4 u_3 u_5

namespace Mathlib

/-!
# Midpoint of a segment

## Main definitions

* `midpoint R x y`: midpoint of the segment `[x, y]`. We define it for `x` and `y`
  in a module over a ring `R` with invertible `2`.
* `add_monoid_hom.of_map_midpoint`: construct an `add_monoid_hom` given a map `f` such that
  `f` sends zero to zero and midpoints to midpoints.

## Main theorems

* `midpoint_eq_iff`: `z` is the midpoint of `[x, y]` if and only if `x + y = z + z`,
* `midpoint_unique`: `midpoint R x y` does not depend on `R`;
* `midpoint x y` is linear both in `x` and `y`;
* `point_reflection_midpoint_left`, `point_reflection_midpoint_right`:
  `equiv.point_reflection (midpoint R x y)` swaps `x` and `y`.

We do not mark most lemmas as `@[simp]` because it is hard to tell which side is simpler.

## Tags

midpoint, add_monoid_hom
-/

/-- `midpoint x y` is the midpoint of the segment `[x, y]`. -/
def midpoint (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) : P :=
  coe_fn (affine_map.line_map x y) ⅟

@[simp] theorem affine_map.map_midpoint {R : Type u_1} {V : Type u_2} {V' : Type u_3} {P : Type u_4} {P' : Type u_5} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] [add_comm_group V'] [semimodule R V'] [add_torsor V' P'] (f : affine_map R P P') (a : P) (b : P) : coe_fn f (midpoint R a b) = midpoint R (coe_fn f a) (coe_fn f b) :=
  affine_map.apply_line_map f a b ⅟

@[simp] theorem affine_equiv.map_midpoint {R : Type u_1} {V : Type u_2} {V' : Type u_3} {P : Type u_4} {P' : Type u_5} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] [add_comm_group V'] [semimodule R V'] [add_torsor V' P'] (f : affine_equiv R P P') (a : P) (b : P) : coe_fn f (midpoint R a b) = midpoint R (coe_fn f a) (coe_fn f b) :=
  affine_equiv.apply_line_map f a b ⅟

@[simp] theorem affine_equiv.point_reflection_midpoint_left {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) : coe_fn (affine_equiv.point_reflection R (midpoint R x y)) x = y := sorry

theorem midpoint_comm {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) : midpoint R x y = midpoint R y x := sorry

@[simp] theorem affine_equiv.point_reflection_midpoint_right {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) : coe_fn (affine_equiv.point_reflection R (midpoint R x y)) y = x := sorry

theorem midpoint_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) : midpoint R p₁ p₂ -ᵥ midpoint R p₃ p₄ = midpoint R (p₁ -ᵥ p₃) (p₂ -ᵥ p₄) :=
  affine_map.line_map_vsub_line_map p₁ p₂ p₃ p₄ ⅟

theorem midpoint_vadd_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) : midpoint R v v' +ᵥ midpoint R p p' = midpoint R (v +ᵥ p) (v' +ᵥ p') :=
  affine_map.line_map_vadd_line_map v v' p p' ⅟

theorem midpoint_eq_iff {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {y : P} {z : P} : midpoint R x y = z ↔ coe_fn (affine_equiv.point_reflection R z) x = y := sorry

@[simp] theorem midpoint_vsub_left {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) : midpoint R p₁ p₂ -ᵥ p₁ = ⅟ • (p₂ -ᵥ p₁) :=
  affine_map.line_map_vsub_left p₁ p₂ ⅟

@[simp] theorem midpoint_vsub_right {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) : midpoint R p₁ p₂ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (midpoint R p₁ p₂ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂))) (midpoint_comm p₁ p₂)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (midpoint R p₂ p₁ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂))) (midpoint_vsub_left p₂ p₁)))
      (Eq.refl (⅟ • (p₁ -ᵥ p₂))))

@[simp] theorem left_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) : p₁ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₁ -ᵥ p₂) :=
  affine_map.left_vsub_line_map p₁ p₂ ⅟

@[simp] theorem right_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) : p₂ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₂ -ᵥ p₁) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p₂ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₂ -ᵥ p₁))) (midpoint_comm p₁ p₂)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p₂ -ᵥ midpoint R p₂ p₁ = ⅟ • (p₂ -ᵥ p₁))) (left_vsub_midpoint p₂ p₁)))
      (Eq.refl (⅟ • (p₂ -ᵥ p₁))))

@[simp] theorem midpoint_sub_left {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : midpoint R v₁ v₂ - v₁ = ⅟ • (v₂ - v₁) :=
  midpoint_vsub_left v₁ v₂

@[simp] theorem midpoint_sub_right {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : midpoint R v₁ v₂ - v₂ = ⅟ • (v₁ - v₂) :=
  midpoint_vsub_right v₁ v₂

@[simp] theorem left_sub_midpoint {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : v₁ - midpoint R v₁ v₂ = ⅟ • (v₁ - v₂) :=
  left_vsub_midpoint v₁ v₂

@[simp] theorem right_sub_midpoint {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : v₂ - midpoint R v₁ v₂ = ⅟ • (v₂ - v₁) :=
  right_vsub_midpoint v₁ v₂

theorem midpoint_eq_midpoint_iff_vsub_eq_vsub (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {x' : P} {y : P} {y' : P} : midpoint R x y = midpoint R x' y' ↔ x -ᵥ x' = y' -ᵥ y := sorry

theorem midpoint_eq_iff' (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {y : P} {z : P} : midpoint R x y = z ↔ coe_fn (equiv.point_reflection z) x = y :=
  midpoint_eq_iff

/-- `midpoint` does not depend on the ring `R`. -/
theorem midpoint_unique (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (R' : Type u_3) [ring R'] [invertible (bit0 1)] [semimodule R' V] (x : P) (y : P) : midpoint R x y = midpoint R' x y :=
  iff.mpr (midpoint_eq_iff' R) (iff.mp (midpoint_eq_iff' R') rfl)

@[simp] theorem midpoint_self (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) : midpoint R x x = x :=
  affine_map.line_map_same_apply x ⅟

@[simp] theorem midpoint_add_self (R : Type u_1) {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (x : V) (y : V) : midpoint R x y + midpoint R x y = x + y := sorry

theorem midpoint_zero_add (R : Type u_1) {V : Type u_2} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] (x : V) (y : V) : midpoint R 0 (x + y) = midpoint R x y := sorry

theorem line_map_inv_two {R : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring R] [char_zero R] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) : coe_fn (affine_map.line_map a b) (bit0 1⁻¹) = midpoint R a b :=
  rfl

theorem line_map_one_half {R : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring R] [char_zero R] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) : coe_fn (affine_map.line_map a b) (1 / bit0 1) = midpoint R a b := sorry

theorem homothety_inv_of_two {R : Type u_1} {V : Type u_2} {P : Type u_3} [comm_ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) : coe_fn (affine_map.homothety a ⅟) b = midpoint R a b :=
  rfl

theorem homothety_inv_two {k : Type u_1} {V : Type u_2} {P : Type u_3} [field k] [char_zero k] [add_comm_group V] [semimodule k V] [add_torsor V P] (a : P) (b : P) : coe_fn (affine_map.homothety a (bit0 1⁻¹)) b = midpoint k a b :=
  rfl

theorem homothety_one_half {k : Type u_1} {V : Type u_2} {P : Type u_3} [field k] [char_zero k] [add_comm_group V] [semimodule k V] [add_torsor V P] (a : P) (b : P) : coe_fn (affine_map.homothety a (1 / bit0 1)) b = midpoint k a b := sorry

@[simp] theorem pi_midpoint_apply {k : Type u_1} {ι : Type u_2} {V : ι → Type u_3} {P : ι → Type u_4} [field k] [invertible (bit0 1)] [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (f : (i : ι) → P i) (g : (i : ι) → P i) (i : ι) : midpoint k f g i = midpoint k (f i) (g i) :=
  rfl

namespace add_monoid_hom

/-- A map `f : E → F` sending zero to zero and midpoints to midpoints is an `add_monoid_hom`. -/
def of_map_midpoint (R : Type u_1) (R' : Type u_2) {E : Type u_3} {F : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group E] [semimodule R E] [ring R'] [invertible (bit0 1)] [add_comm_group F] [semimodule R' F] (f : E → F) (h0 : f 0 = 0) (hm : ∀ (x y : E), f (midpoint R x y) = midpoint R' (f x) (f y)) : E →+ F :=
  mk f h0 sorry

@[simp] theorem coe_of_map_midpoint (R : Type u_1) (R' : Type u_2) {E : Type u_3} {F : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group E] [semimodule R E] [ring R'] [invertible (bit0 1)] [add_comm_group F] [semimodule R' F] (f : E → F) (h0 : f 0 = 0) (hm : ∀ (x y : E), f (midpoint R x y) = midpoint R' (f x) (f y)) : ⇑(of_map_midpoint R R' f h0 hm) = f :=
  rfl