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

Basic machinery for defining general coinductive types

Work in progress
-/
import data.pfun tactic.interactive ..for_mathlib .basic

universes u v w

open nat function list (hiding head')

variables (F : pfunctor.{u})

local prefix `♯`:0 := cast (by simp [*] <|> cc <|> solve_by_elim)

namespace pfunctor
namespace approx

inductive cofix_a : ℕ → Type u
| continue : cofix_a 0
| intro {n} : ∀ a, (F.B a → cofix_a n) → cofix_a (succ n)

@[extensionality]
lemma cofix_a_eq_zero : ∀ x y : cofix_a F 0, x = y
| (cofix_a.continue _) (cofix_a.continue _) := rfl

variables {F}

def head' : Π {n}, cofix_a F (succ n) → F.A
 | n (cofix_a.intro i _) := i

def children' : Π {n} (x : cofix_a F (succ n)), F.B (head' x) → cofix_a F n
 | n (cofix_a.intro a f) := f

lemma approx_eta  {n : ℕ} (x : cofix_a F (n+1)) :
  x = cofix_a.intro (head' x) (children' x) :=
by cases x; refl

inductive agree
: ∀ {n : ℕ}, cofix_a F n → cofix_a F (n+1) → Prop
 | continue (x : cofix_a F 0) (y : cofix_a F 1) : agree x y
 | intro {n} {a} (x : F.B a → cofix_a F n) (x' : F.B a → cofix_a F (n+1)) :
   (∀ i : F.B a, agree (x i) (x' i)) →
   agree (cofix_a.intro a x) (cofix_a.intro a x')

def all_agree (x : Π n, cofix_a F n) :=
∀ n, agree (x n) (x (succ n))

@[simp]
lemma agree_trival {x : cofix_a F 0} {y : cofix_a F 1}
: agree x y :=
by { constructor }

lemma agree_children {n : ℕ} (x : cofix_a F (succ n)) (y : cofix_a F (succ n+1))
  {i j}
  (h₀ : i == j)
  (h₁ : agree x y)
: agree (children' x i) (children' y j) :=
begin
  cases h₁, cases h₀,
  apply h₁_a_1,
end

def truncate
: ∀ {n : ℕ}, cofix_a F (n+1) → cofix_a F n
 | 0 (cofix_a.intro _ _) := cofix_a.continue _
 | (succ n) (cofix_a.intro i f) := cofix_a.intro i $ truncate ∘ f

lemma truncate_eq_of_agree {n : ℕ}
  (x : cofix_a F n)
  (y : cofix_a F (succ n))
  (h : agree x y)
: truncate y = x :=
begin
  induction n generalizing x y
  ; cases x ; cases y,
  { refl },
  { cases h with _ _ _ _ _ h₀ h₁,
    cases h,
    simp [truncate,exists_imp_distrib,(∘)],
    ext y, apply n_ih,
    apply h₁ }
end

variables {X : Type w}
variables (f : X → F.apply X)

def s_corec : Π (i : X) n, cofix_a F n
 | _ 0 := cofix_a.continue _
 | j (succ n) :=
   let ⟨y,g⟩ := f j in
   cofix_a.intro y (λ i, s_corec (g i) _)

lemma P_corec (i : X) (n : ℕ) : agree (s_corec f i n) (s_corec f i (succ n)) :=
begin
  induction n with n generalizing i,
  constructor,
  cases h : f i with y g,
  simp [s_corec,h,s_corec._match_1] at ⊢ n_ih,
  constructor,
  introv,
  apply n_ih,
end

def path (F : pfunctor.{u}) := list F.Idx

open list

instance : subsingleton (cofix_a F 0) :=
⟨ by { intros, casesm* cofix_a F 0, refl } ⟩

open list nat
lemma head_succ' (n m : ℕ) (x : Π n, cofix_a F n)
  (Hconsistent : all_agree x)
: head' (x (succ n)) = head' (x (succ m)) :=
begin
  suffices : ∀ n, head' (x (succ n)) = head' (x 1),
  { simp [this] },
  clear m n, intro,
  cases h₀ : x (succ n) with _ i₀ f₀,
  cases h₁ : x 1 with _ i₁ f₁,
  simp [head'],
  induction n with n,
  { rw h₁ at h₀, cases h₀, trivial },
  { have H := Hconsistent (succ n),
    cases h₂ : x (succ n) with _ i₂ f₂,
    rw [h₀,h₂] at H,
    apply n_ih (truncate ∘ f₀),
    rw h₂,
    cases H,
    congr, funext j, dsimp [comp],
    rw truncate_eq_of_agree,
    apply H_a_1 }
end

end approx
open approx

structure M_intl :=
  (approx : ∀ n, cofix_a F n)
  (consistent : all_agree approx)

def M := M_intl

namespace M

lemma ext' (x y : M F)
  (H : ∀ i : ℕ, x.approx i = y.approx i)
: x = y :=
begin
  cases x, cases y,
  congr, ext, apply H,
end

variables {X : Type*}
variables (f : X → F.apply X)
variables {F}

protected def corec (i : X) : M F :=
{ approx := s_corec f i
, consistent := P_corec _ _ }

variables {F}

def head : M F → F.A
 | x := head' (x.1 1)

def children : Π (x : M F), F.B (head x) → M F
| x i :=
   let H := λ n : ℕ, @head_succ' _ n 0 x.1 x.2 in
   { approx := λ n, children' (x.1 _) (cast (congr_arg _ $ by simp [head,H]; refl) i)
   , consistent :=
     begin
       intro,
       have P' := x.2 (succ n),
       apply agree_children _ _ _ P',
       transitivity i,
       apply cast_heq,
       symmetry,
       apply cast_heq,
     end }

def ichildren [inhabited (M F)] [decidable_eq F.A] : F.Idx → M F → M F
 | i x :=
if H' : i.1 = head x
  then children x (cast (congr_arg _ $ by simp [head,H']; refl) i.2)
  else default _

lemma head_succ (n m : ℕ) (x : M F)
: head' (x.approx (succ n)) = head' (x.approx (succ m)) :=
head_succ' n m _ x.consistent

lemma head_eq_head' : Π (x : M F) (n : ℕ),
  head x = head' (x.approx $ n+1)
| ⟨x,h⟩ n := head_succ' _ _ _ h

lemma head'_eq_head : Π (x : M F) (n : ℕ),
  head' (x.approx $ n+1) = head x
| ⟨x,h⟩ n := head_succ' _ _ _ h

lemma truncate_approx (x : M F) (n : ℕ) :
  truncate (x.approx $ n+1) = x.approx n :=
truncate_eq_of_agree _ _ (x.consistent _)

def from_cofix : M F → F.apply (M F)
 | x := ⟨head x,λ i, children x i ⟩

namespace approx

protected def s_mk (x : F.apply $ M F) : Π n, cofix_a F n
 | 0 :=  cofix_a.continue _
 | (succ n) := cofix_a.intro x.1 (λ i, (x.2 i).approx n)

protected def P_mk  (x : F.apply $ M F)
: all_agree (approx.s_mk x)
 | 0 := by { constructor }
 | (succ n) := by { constructor, introv,
                    apply (x.2 i).consistent }

end approx

protected def mk (x : F.apply $ M F) : M F :=
{ approx := approx.s_mk x
, consistent := approx.P_mk x }

inductive agree' : ℕ → M F → M F → Prop
| trivial (x y : M F) : agree' 0 x y
| step {n : ℕ} {a} (x y : F.B a → M F) {x' y'} :
  x' = M.mk ⟨a,x⟩ →
  y' = M.mk ⟨a,y⟩ →
  (∀ i, agree' n (x i) (y i)) →
  agree' (succ n) x' y'

@[simp]
lemma from_cofix_mk (x : F.apply $ M F)
: from_cofix (M.mk x) = x :=
begin
  funext i,
  dsimp [M.mk,from_cofix],
  cases x with x ch, congr, ext i,
  cases h : ch i,
  simp [children,M.approx.s_mk,children',cast_eq],
  dsimp [M.approx.s_mk,children'],
  congr, rw h,
end

lemma mk_from_cofix (x : M F)
: M.mk (from_cofix x) = x :=
begin
  apply ext', intro n,
  dsimp [M.mk],
  induction n with n,
  { dsimp [head], ext },
  dsimp [approx.s_mk,from_cofix,head],
  cases h : x.approx (succ n) with _ hd ch,
  have h' : hd = head' (x.approx 1),
  { rw [← head_succ' n,h,head'], apply x.consistent },
  revert ch, rw h', intros, congr,
  { ext a, dsimp [children],
    h_generalize! hh : a == a'',
    rw h, intros, cases hh, refl },
end

lemma mk_inj {x y : F.apply $ M F}
  (h : M.mk x = M.mk y) : x = y :=
by rw [← from_cofix_mk x,h,from_cofix_mk]

protected def cases {r : M F → Sort w}
  (f : ∀ (x : F.apply $ M F), r (M.mk x)) (x : M F) : r x :=
suffices r (M.mk (from_cofix x)),
  by { haveI := classical.prop_decidable,
       haveI := inhabited.mk x,
       rw [← mk_from_cofix x], exact this },
f _

protected def cases_on {r : M F → Sort w}
  (x : M F) (f : ∀ (x : F.apply $ M F), r (M.mk x)) : r x :=
M.cases f x

protected def cases_on' {r : M F → Sort w}
  (x : M F) (f : ∀ a f, r (M.mk ⟨a,f⟩)) : r x :=
M.cases_on x (λ ⟨a,g⟩, f a _)

lemma approx_mk (a : F.A) (f : F.B a → M F) (i : ℕ) :
  (M.mk ⟨a, f⟩).approx (succ i) = cofix_a.intro a (λ j, (f j).approx i) :=
by refl

lemma agree'_refl [inhabited (M F)] [decidable_eq F.A] {n : ℕ} (x : M F) :
  agree' n x x :=
by { induction n generalizing x; induction x using pfunctor.M.cases_on'; constructor; try { refl }, intros, apply n_ih }

lemma agree_iff_agree' [inhabited (M F)] [decidable_eq F.A] {n : ℕ} (x y : M F) :
  agree (x.approx n) (y.approx $ n+1) ↔ agree' n x y :=
begin
  split; intros h,
  { induction n generalizing x y, constructor,
    { induction x using pfunctor.M.cases_on',
      induction y using pfunctor.M.cases_on',
      simp only [approx_mk] at h, cases h,
      constructor; try { refl },
      intro i, apply n_ih, apply h_a_1 } },
  { induction n generalizing x y, constructor,
    { cases h,
      induction x using pfunctor.M.cases_on',
      induction y using pfunctor.M.cases_on',
      simp only [approx_mk],
      replace h_a_1 := mk_inj h_a_1, cases h_a_1,
      replace h_a_2 := mk_inj h_a_2, cases h_a_2,
      constructor, intro i, apply n_ih, apply h_a_3 } },
end

@[simp]
lemma cases_mk {r : M F → Sort*} (x : F.apply $ M F) (f : Π (x : F.apply $ M F), r (M.mk x))
: pfunctor.M.cases f (M.mk x) = f x :=
begin
  dsimp [M.mk,pfunctor.M.cases,from_cofix,head,approx.s_mk,head'],
  cases x, dsimp [approx.s_mk],
  apply eq_of_heq,
  apply rec_heq_of_heq, congr,
  ext, dsimp [children,approx.s_mk,children'],
  cases h : x_snd x, dsimp [head],
  congr, ext,
  change (x_snd (x)).approx x_1 = _,
  rw h
end

@[simp]
lemma cases_on_mk {r : M F → Sort*} (x : F.apply $ M F) (f : Π x : F.apply $ M F, r (M.mk x))
: pfunctor.M.cases_on (M.mk x) f = f x :=
cases_mk x f

@[simp]
lemma cases_on_mk' {r : M F → Sort*} {a} (x : F.B a → M F) (f : Π a (f : F.B a → M F), r (M.mk ⟨a,f⟩))
: pfunctor.M.cases_on' (M.mk ⟨a,x⟩) f = f a x :=
cases_mk ⟨_,x⟩ _

inductive is_path  : path F → M F → Prop
| nil (x : M F) : is_path [] x
| cons (xs : path F) {a} (x : M F) (f : F.B a → M F) (i : F.B a) :
  x = M.mk ⟨a,f⟩ →
  is_path xs (f i) →
  is_path (⟨a,i⟩ :: xs) x

lemma is_path_cons {xs : path F} {a a'} {f : F.B a → M F} {i : F.B a'}
  (h : is_path (⟨a',i⟩ :: xs) (M.mk ⟨a,f⟩)) :
  a = a' :=
begin
  revert h, generalize h : (M.mk ⟨a,f⟩) = x,
  intros h', cases h', subst x,
  cases mk_inj h'_a_1, refl,
end

lemma is_path_cons' {xs : path F} {a} {f : F.B a → M F} {i : F.B a}
  (h : is_path (⟨a,i⟩ :: xs) (M.mk ⟨a,f⟩)) :
  is_path xs (f i) :=
begin
  revert h, generalize h : (M.mk ⟨a,f⟩) = x,
  intros h', cases h', subst x,
  cases mk_inj h'_a_1, exact h'_a_2,
end

def isubtree [decidable_eq F.A] [inhabited (M F)] : path F → M F → M F
 | [] x := x
 | (⟨a, i⟩ :: ps) x :=
pfunctor.M.cases_on' x (λ a' f,
(if h : a = a' then isubtree ps (f $ cast (by rw h) i)
 else default (M F) : (λ x, M F) (M.mk ⟨a',f⟩)))

def iselect [decidable_eq F.A] [inhabited (M F)] (ps : path F) : M F → F.A :=
λ (x : M F), head $ isubtree ps x

lemma iselect_eq_default [decidable_eq F.A] [inhabited (M F)] (ps : path F) (x : M F)
  (h : ¬ is_path ps x) :
  iselect ps x = head (default $ M F) :=
begin
  induction ps generalizing x,
  { exfalso, apply h, constructor },
  { cases ps_hd with a i,
    induction x using pfunctor.M.cases_on',
    simp [iselect,isubtree] at ps_ih ⊢,
    by_cases h'' : a = x_a, subst x_a,
    { simp *, rw ps_ih, intro h', apply h,
      constructor; try { refl }, apply h' },
    { simp * } }
end

lemma head_mk (x : F.apply (M F)) :
  head (M.mk x) = x.1 :=
eq.symm $
calc  x.1
    = (from_cofix (M.mk x)).1 : by rw from_cofix_mk
... = head (M.mk x)           : by refl

lemma children_mk {a} (x : F.B a → (M F)) (i : F.B (head (M.mk ⟨a,x⟩)))
: children (M.mk ⟨a,x⟩) i = x (cast (by rw head_mk) i) :=
by apply ext'; intro n; refl

lemma ichildren_mk [decidable_eq F.A] [inhabited (M F)] (x : F.apply (M F)) (i : F.Idx)
: ichildren i (M.mk x) = x.iget i :=
by { dsimp [ichildren,pfunctor.apply.iget],
     congr, ext, apply ext',
     dsimp [children',M.mk,approx.s_mk],
     intros, refl }

lemma isubtree_cons [decidable_eq F.A] [inhabited (M F)] (ps : path F) {a} (f : F.B a → M F) {i : F.B a} :
  isubtree (⟨_,i⟩ :: ps) (M.mk ⟨a,f⟩) = isubtree ps (f i) :=
by simp only [isubtree,ichildren_mk,pfunctor.apply.iget,dif_pos,isubtree,M.cases_on_mk']; refl

lemma iselect_nil [decidable_eq F.A] [inhabited (M F)] {a} (f : F.B a → M F) :
  iselect nil (M.mk ⟨a,f⟩) = a :=
by refl

lemma iselect_cons [decidable_eq F.A] [inhabited (M F)] (ps : path F) {a} (f : F.B a → M F) {i} :
  iselect (⟨a,i⟩ :: ps) (M.mk ⟨a,f⟩) = iselect ps (f i) :=
by simp only [iselect,isubtree_cons]

lemma corec_def {X} (f : X → F.apply X) (x₀ : X) :
  M.corec f x₀ = M.mk (M.corec f <$> f x₀)  :=
begin
  dsimp [M.corec,M.mk],
  congr, ext n,
  cases n with n,
  { dsimp [s_corec,approx.s_mk], refl, },
  { dsimp [s_corec,approx.s_mk], cases h : (f x₀),
    dsimp [s_corec._match_1,(<$>),pfunctor.map],
    congr, }
end

lemma ext_aux [inhabited (M F)] [decidable_eq F.A] {n : ℕ} (x y z : M F)
  (hx : agree' n z x)
  (hy : agree' n z y)
  (hrec : ∀ (ps : path F),
             n = ps.length →
            iselect ps x = iselect ps y)
: x.approx (n+1) = y.approx (n+1) :=
begin
  induction n with n generalizing x y z,
  { specialize hrec [] rfl,
    induction x using pfunctor.M.cases_on', induction y using pfunctor.M.cases_on',
    simp only [iselect_nil] at hrec, subst hrec,
    simp only [approx_mk, true_and, eq_self_iff_true, heq_iff_eq],
    ext, },
  { cases hx, cases hy,
    induction x using pfunctor.M.cases_on', induction y using pfunctor.M.cases_on',
    subst z,
    replace hx_a_2 := mk_inj hx_a_2, cases hx_a_2,
    replace hy_a_1 := mk_inj hy_a_1, cases hy_a_1,
    replace hy_a_2 := mk_inj hy_a_2, cases hy_a_2,
    simp [approx_mk], ext i, apply n_ih,
    { apply hx_a_3 }, { apply hy_a_3 },
    introv h, specialize hrec (⟨_,i⟩ :: ps) (congr_arg _ h),
    simp [iselect_cons] at hrec, exact hrec }
end

open pfunctor.approx

-- variables (F : pfunctor.{v})
variables {F}

local prefix `♯`:0 := cast (by simp [*] <|> cc <|> solve_by_elim)

local attribute [instance, priority 0] classical.prop_decidable

lemma ext [inhabited (M F)] [decidable_eq F.A]
  (x y : M F)
  (H : ∀ (ps : path F), iselect ps x = iselect ps y)
: x = y :=
begin
  apply ext', intro i,
  induction i with i,
  { cases x.approx 0, cases y.approx 0, constructor },
  { apply ext_aux x y x,
    { rw ← agree_iff_agree', apply x.consistent },
    { rw [← agree_iff_agree',i_ih], apply y.consistent },
    introv H',
    simp [iselect] at H,
    cases H',
    apply H ps }
end

section bisim
  variable (R : M F → M F → Prop)
  local infix ~ := R

  structure is_bisimulation :=
  (head : ∀ {a a'} {f f'}, M.mk ⟨a,f⟩ ~ M.mk ⟨a',f'⟩ → a = a')
  (tail : ∀ {a} {f f' : F.B a → M F},
    M.mk ⟨a,f⟩ ~ M.mk ⟨a,f'⟩ →
    (∀ (i : F.B a), f i ~ f' i) )

  variables [inhabited (M F)] [decidable_eq F.A]
  theorem nth_of_bisim (bisim : is_bisimulation R) (s₁ s₂) (ps : path F) :
       s₁ ~ s₂ →
         is_path ps s₁ ∨ is_path ps s₂ →
         iselect ps s₁ = iselect ps s₂ ∧
         ∃ a (f f' : F.B a → M F),
           isubtree ps s₁ = M.mk ⟨a,f⟩ ∧
           isubtree ps s₂ = M.mk ⟨a,f'⟩ ∧
         ∀ (i : F.B a), f i ~ f' i :=
  begin
    intros h₀ hh,
    induction s₁ using pfunctor.M.cases_on' with a f,
      induction s₂ using pfunctor.M.cases_on' with a' f',
      have : a = a' := bisim.head h₀, subst a',
      induction ps with i ps generalizing a f f',
      { existsi [rfl,a,f,f',rfl,rfl],
        apply bisim.tail h₀ },
      cases i with a' i,
      have : a = a',
      { cases hh; cases is_path_cons hh; refl },
      subst a', dsimp [iselect] at ps_ih ⊢,
      have h₁ := bisim.tail h₀ i,
      induction h : (f i) using pfunctor.M.cases_on' with a₀ f₀,
      induction h' : (f' i) using pfunctor.M.cases_on' with a₁ f₁,
      simp only [h,h',isubtree_cons] at ps_ih ⊢,
      rw [h,h'] at h₁,
      have : a₀ = a₁ := bisim.head h₁, subst a₁,
      apply (ps_ih _ _ _ h₁),
      rw [← h,← h'], apply or_of_or_of_imp_of_imp hh is_path_cons' is_path_cons'
  end

  theorem eq_of_bisim (bisim : is_bisimulation R) : ∀ s₁ s₂, s₁ ~ s₂ → s₁ = s₂ :=
  begin
    introv Hr, apply ext,
    introv,
    by_cases h : is_path ps s₁ ∨ is_path ps s₂,
    { have H := nth_of_bisim R bisim _ _ ps Hr h,
      exact H.left },
    { rw not_or_distrib at h, cases h with h₀ h₁,
      simp only [iselect_eq_default,*,not_false_iff] }
  end
end bisim

section coinduction

variables F

coinductive R : Π (s₁ s₂ : M F), Prop
| intro {a} (s₁ s₂ : F.B a → M F) :
   (∀ i, R (s₁ i) (s₂ i)) →
   R (M.mk ⟨_,s₁⟩) (M.mk ⟨_,s₂⟩)

section
variables [decidable_eq F.A] [inhabited $ M F]

open ulift
lemma R_is_bisimulation : is_bisimulation (R F) :=
begin
  constructor; introv hr,
  { suffices : (λ a b, head a = head b) (M.mk ⟨a, f⟩) (M.mk ⟨a', f'⟩),
    { simp only [head_mk] at this, exact this },
    refine R.cases_on _ hr _,
    intros, simp only [head_mk] },
  { suffices : (λ a b, ∀ i j, i == j → R F (children a i) (children b j)) (M.mk ⟨a, f⟩) (M.mk ⟨a, f'⟩),
    { specialize this (cast (by rw head_mk) i) (cast (by rw head_mk) i) heq.rfl,
      simp only [children_mk] at this, exact this, },
    refine R.cases_on _ hr _,
    introv h₂ h₃,
    let k := cast (by rw head_mk) i_1,
    have h₀ : (children (M.mk ⟨a_1, s₁⟩) i_1) = s₁ k := children_mk _ _,
    have h₁ : (children (M.mk ⟨a_1, s₂⟩) j) = s₂ k,
    { rw children_mk, congr, symmetry, apply eq_of_heq h₃ },
    rw [h₀,h₁], apply h₂ },
end

end
variables {F}

lemma coinduction {s₁ s₂ : M F}
  (hh : R _ s₁ s₂)
: s₁ = s₂ :=
begin
  haveI := inhabited.mk s₁,
  exact eq_of_bisim
    (R F) (R_is_bisimulation F) _ _
    hh
end

lemma coinduction' {s₁ s₂ : M F}
  (hh : R _ s₁ s₂)
: s₁ = s₂ :=
begin
  have hh' := hh, revert hh',
  apply R.cases_on F hh, clear hh s₁ s₂,
  introv h₀ h₁,
  rw coinduction h₁
end

end coinduction

universes u' v'

def corec_on {X : Type*} (x₀ : X) (f : X → F.apply X) : M F :=
M.corec f x₀

end M

end pfunctor

namespace tactic.interactive
open tactic (hiding coinduction) lean.parser interactive

meta def bisim (g : parse $ optional (tk "generalizing" *> many ident)) : tactic unit :=
do applyc ``pfunctor.M.coinduction,
   coinduction ``pfunctor.M.R.corec_on g

end tactic.interactive

namespace pfunctor

open M

variables {P : pfunctor.{u}} {α : Type u}

def M_dest : M P → P.apply (M P) := from_cofix

def M_corec : (α → P.apply α) → (α → M P) := M.corec

lemma M_dest_corec (g : α → P.apply α) (x : α) :
  M_dest (M_corec g x) = M_corec g <$> g x :=
by rw [M_corec,M_dest,corec_def,from_cofix_mk]

lemma M_bisim (R : M P → M P → Prop)
    (h : ∀ x y, R x y → ∃ a f f',
      M_dest x = ⟨a, f⟩ ∧
      M_dest y = ⟨a, f'⟩ ∧
      ∀ i, R (f i) (f' i)) :
  ∀ x y, R x y → x = y :=
begin
  intros,
  bisim generalizing x y, rename w x; rename h_1_w y; rename h_1_h_left ih,
  rcases h _ _ ih with ⟨ a', f, f', h₀, h₁, h₂ ⟩, clear h, dsimp [M_dest] at h₀ h₁,
  existsi [a',f,f'], split,
  { intro, existsi [f i,f' i,h₂ _,rfl], refl },
  split,
  { rw [← h₀,mk_from_cofix] },
  { rw [← h₁,mk_from_cofix] },
end

theorem M_bisim' {α : Type*} (Q : α → Prop) (u v : α → M P)
    (h : ∀ x, Q x → ∃ a f f',
      M_dest (u x) = ⟨a, f⟩ ∧
      M_dest (v x) = ⟨a, f'⟩ ∧
      ∀ i, ∃ x', Q x' ∧ f i = u x' ∧ f' i = v x') :
  ∀ x, Q x → u x = v x :=
λ x Qx,
let R := λ w z : M P, ∃ x', Q x' ∧ w = u x' ∧ z = v x' in
@M_bisim P R
  (λ x y ⟨x', Qx', xeq, yeq⟩,
    let ⟨a, f, f', ux'eq, vx'eq, h'⟩ := h x' Qx' in
      ⟨a, f, f', xeq.symm ▸ ux'eq, yeq.symm ▸ vx'eq, h'⟩)
  _ _ ⟨x, Qx, rfl, rfl⟩

-- for the record, show M_bisim follows from M_bisim'
theorem M_bisim_equiv (R : M P → M P → Prop)
    (h : ∀ x y, R x y → ∃ a f f',
      M_dest x = ⟨a, f⟩ ∧
      M_dest y = ⟨a, f'⟩ ∧
      ∀ i, R (f i) (f' i)) :
  ∀ x y, R x y → x = y :=
λ x y Rxy,
let Q : M P × M P → Prop := λ p, R p.fst p.snd in
M_bisim' Q prod.fst prod.snd
  (λ p Qp,
    let ⟨a, f, f', hx, hy, h'⟩ := h p.fst p.snd Qp in
    ⟨a, f, f', hx, hy, λ i, ⟨⟨f i, f' i⟩, h' i, rfl, rfl⟩⟩)
  ⟨x, y⟩ Rxy

theorem M_corec_unique (g : α → P.apply α) (f : α → M P)
    (hyp : ∀ x, M_dest (f x) = f <$> (g x)) :
  f = M_corec g :=
begin
  ext x,
  apply M_bisim' (λ x, true) _ _ _ _ trivial,
  clear x,
  intros x _,
  cases gxeq : g x with a f',
  have h₀ : M_dest (f x) = ⟨a, f ∘ f'⟩,
  { rw [hyp, gxeq, pfunctor.map_eq] },
  have h₁ : M_dest (M_corec g x) = ⟨a, M_corec g ∘ f'⟩,
  { rw [M_dest_corec, gxeq, pfunctor.map_eq], },
  refine ⟨_, _, _, h₀, h₁, _⟩,
  intro i,
  exact ⟨f' i, trivial, rfl, rfl⟩
end

def M_mk : P.apply (M P) → M P := M_corec (λ x, M_dest <$> x)

theorem M_mk_M_dest (x : M P) : M_mk (M_dest x) = x :=
begin
  apply M_bisim' (λ x, true) (M_mk ∘ M_dest) _ _ _ trivial,
  clear x,
  intros x _,
  cases Mxeq : M_dest x with a f',
  have : M_dest (M_mk (M_dest x)) = ⟨a, _⟩,
  { rw [M_mk, M_dest_corec, Mxeq, pfunctor.map_eq, pfunctor.map_eq] },
  refine ⟨_, _, _, this, rfl, _⟩,
  intro i,
  exact ⟨f' i, trivial, rfl, rfl⟩
end

theorem M_dest_M_mk (x : P.apply (M P)) : M_dest (M_mk x) = x :=
begin
  have : M_mk ∘ M_dest = id := funext M_mk_M_dest,
  rw [M_mk, M_dest_corec, ←comp_map, ←M_mk, this, id_map, id]
end

def corec₁ {α : Type u} (F : Π X, (α → X) → α → P.apply X) : α → M P :=
M_corec (F _ id)

def M_corec' {α : Type u} (F : Π {X : Type u}, (α → X) → α → M P ⊕ P.apply X) (x : α) : M P :=
corec₁
(λ X rec (a : M P ⊕ α),
     let y := a >>= F (rec ∘ sum.inr) in
     match y with
     | sum.inr y := y
     | sum.inl y := (rec ∘ sum.inl) <$> M_dest y
     end )
(@sum.inr (M P) _ x)

end pfunctor


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import category_theory.preadditive.default

/-!
# Preadditive structure on functor categories

If `C` and `D` are categories and `D` is preadditive,
then `C ⥤ D` is also preadditive.

-/

open_locale big_operators

namespace category_theory
open category_theory.limits preadditive

variables {C D : Type*} [category C] [category D] [preadditive D]

instance : preadditive (C ⥤ D) :=
{ hom_group := λ F G,
  { add := λ α β,
    { app := λ X, α.app X + β.app X,
      naturality' := by { intros, rw [comp_add, add_comp, α.naturality, β.naturality] } },
    zero := { app := λ X, 0, naturality' := by { intros, rw [zero_comp, comp_zero] } },
    neg := λ α,
    { app := λ X, -α.app X,
      naturality' := by { intros, rw [comp_neg, neg_comp, α.naturality] } },
    sub := λ α β,
    { app := λ X, α.app X - β.app X,
      naturality' := by { intros, rw [comp_sub, sub_comp, α.naturality, β.naturality] } },
    add_assoc := by { intros, ext, apply add_assoc },
    zero_add := by { intros, ext, apply zero_add },
    add_zero := by { intros, ext, apply add_zero },
    sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg },
    add_left_neg := by { intros, ext, apply add_left_neg },
    add_comm := by { intros, ext, apply add_comm } },
  add_comp' := by { intros, ext, apply add_comp },
  comp_add' := by { intros, ext, apply comp_add } }

namespace nat_trans

variables {F G : C ⥤ D}

/-- Application of a natural transformation at a fixed object,
as group homomorphism -/
@[simps] def app_hom (X : C) : (F ⟶ G) →+ (F.obj X ⟶ G.obj X) :=
{ to_fun := λ α, α.app X,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

@[simp] lemma app_zero (X : C) : (0 : F ⟶ G).app X = 0 := rfl

@[simp]

@[simp] lemma app_sub (X : C) (α β : F ⟶ G) : (α - β).app X = α.app X - β.app X := rfl

@[simp] lemma app_neg (X : C) (α : F ⟶ G) : (-α).app X = -α.app X := rfl

@[simp] lemma app_nsmul (X : C) (α : F ⟶ G) (n : ℕ) : (n • α).app X = n • α.app X :=
(app_hom X).map_nsmul α n

@[simp] lemma app_zsmul (X : C) (α : F ⟶ G) (n : ℤ) : (n • α).app X = n • α.app X :=
(app_hom X).map_zsmul α n

@[simp] lemma app_sum {ι : Type*} (s : finset ι) (X : C) (α : ι → (F ⟶ G)) :
  (∑ i in s, α i).app X = ∑ i in s, ((α i).app X) :=
by { rw [← app_hom_apply, add_monoid_hom.map_sum], refl }

end nat_trans

end category_theory


lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
    intro h,
    cases h with p q,
    split,
    exact q,
    exact p,
end


import FOL.deduction FOL.semantics

universes u t

namespace fol
open_locale logic_symbol

open formula logic
variables {L : language.{u}} (T : Theory L) (i : ℕ)

notation t` ='[`:50 T :50`] `:0 u:50 := term.equiv T t u

@[symm] lemma term.equiv_refl (T : Theory L) (t : term L) : t ='[T] t := by simp[term.equiv]

@[symm] lemma term.equiv_symm (T : Theory L) (t u : term L) : (t ='[T] u) → (u ='[T] t) := provable.eq_symm

@[trans] lemma term.equiv_trans (T : Theory L) (t u s : term L) : (t ='[T] u) → (u ='[T] s) → (t ='[T] s) := provable.eq_trans

theorem term_equiv_equivalence (T : Theory L) : equivalence (term.equiv T) :=
⟨@term.equiv_refl _ _, @term.equiv_symm _ _, @term.equiv_trans _ _⟩

@[reducible, simp, instance]
def herbrand (n : ℕ) : setoid (term L) := ⟨λ t₁ t₂, T^n ⊢ t₁ =' t₂, term_equiv_equivalence (T^n)⟩

def Herbrand (n : ℕ) : Type u := quotient (herbrand T n)

def term.quo (T : Theory L) (n : ℕ) (t : term L) : Herbrand T n := quotient.mk' t

notation `⟦`t`⟧ᴴ` :max := term.quo _ _ t

instance (T : Theory L) (n) : inhabited (Herbrand T n) := ⟨⟦#0⟧ᴴ⟩

namespace Herbrand
variables {T} {i}

@[elab_as_eliminator]
protected lemma ind_on {C : Herbrand T i → Prop} (d : Herbrand T i)
  (h : ∀ t : term L, C ⟦t⟧ᴴ) : C d :=
quotient.induction_on' d h

@[elab_as_eliminator, reducible]
protected def lift_on {φ} (d : Herbrand T i) (f : term L → φ)
  (h : ∀ t u : term L, T^i ⊢ t =' u → f t = f u) : φ :=
quotient.lift_on' d f h

@[simp]
protected lemma lift_on_eq {φ} (t : term L) (f : term L → φ)
  (h : ∀ t u, T^i ⊢ t =' u → f t = f u) : fol.Herbrand.lift_on (⟦t⟧ᴴ : Herbrand T i) f h = f t := rfl

@[elab_as_eliminator, reducible, simp]
protected def lift_on₂ {φ} (d₁ d₂ : Herbrand T i) (f : term L → term L → φ)
  (h : ∀ t₁ t₂ u₁ u₂, (T^i ⊢ t₁ =' u₁) → (T^i ⊢ t₂ =' u₂) → f t₁ t₂ = f u₁ u₂) : φ :=
quotient.lift_on₂' d₁ d₂ f h

@[simp]
protected lemma lift_on₂_eq {φ} (t u : term L) (f : term L → term L → φ)
  (h : ∀ t₁ t₂ u₁ u₂, (T^i ⊢ t₁ =' u₁) → (T^i ⊢ t₂ =' u₂) → f t₁ t₂ = f u₁ u₂) :
  fol.Herbrand.lift_on₂ ⟦t⟧ᴴ ⟦u⟧ᴴ f h = f t u := rfl

protected def lift_on_finitary {φ} {n : ℕ} (v : finitary (Herbrand T i) n) (f : finitary (term L) n → φ)
  (h : ∀ v₁ v₂ : finitary (term L) n, (∀ n, T^i ⊢ (v₁ n) =' (v₂ n)) → f v₁ = f v₂) : φ :=
quotient.lift_on_finitary v f h

@[simp]
protected lemma lift_on_finitary_eq {φ} {n} (v : finitary (term L) n) (f : finitary (term L) n → φ)
  (h : ∀ v₁ v₂ : finitary (term L) n, (∀ n, T^i ⊢ (v₁ n) =' (v₂ n)) → f v₁ = f v₂) :
  fol.Herbrand.lift_on_finitary (λ x, (⟦v x⟧ᴴ : Herbrand T i)) f h = f v :=
quotient.lift_on_finitary_eq v f h

@[simp]
protected lemma lift_on_finitary_0_eq {φ} (f : finitary (term L) 0 → φ)
  (h : ∀ v₁ v₂ : finitary (term L) 0, (∀ n, T^i ⊢ (v₁ n) =' (v₂ n)) → f v₁ = f v₂)
  (n : finitary (Herbrand T i) 0) :
  fol.Herbrand.lift_on_finitary n f h = f finitary.nil :=
quotient.lift_on_finitary_0_eq f h n

@[simp]
protected lemma lift_on_finitary_1_eq {φ} (t : term L) (f : finitary (term L) 1 → φ)
  (h : ∀ v₁ v₂ : finitary (term L) 1, (∀ n, T^i ⊢ (v₁ n) =' (v₂ n)) → f v₁ = f v₂) :
  fol.Herbrand.lift_on_finitary ‹⟦t⟧ᴴ› f h = f ‹t› :=
quotient.lift_on_finitary_1_eq t f h

@[simp]
protected lemma lift_on_finitary_2_eq {φ} (t u : term L) (f : finitary (term L) 2 → φ)
  (h : ∀ v₁ v₂ : finitary (term L) 2, (∀ n, T^i ⊢ (v₁ n) =' (v₂ n)) → f v₁ = f v₂) :
  fol.Herbrand.lift_on_finitary ‹⟦t⟧ᴴ, ⟦u⟧ᴴ› f h = f ‹t, u› :=
quotient.lift_on_finitary_2_eq t u f h

@[simp]
lemma of_eq_of {t u : term L} : (⟦t⟧ᴴ : Herbrand T i) = ⟦u⟧ᴴ ↔ (T^i ⊢ t =' u) :=
by simp[term.quo, term.equiv, quotient.eq']

def function_of {n} (f : L.fn n) : finitary (Herbrand T i) n → Herbrand T i :=
λ v, fol.Herbrand.lift_on_finitary v (λ u : finitary (term L) n, ⟦term.app f u⟧ᴴ)
  $ λ v₁ v₂ eqs, by simp[of_eq_of]; exact provable.equiv_function_of_equiv f eqs

notation `H❨` c `❩` v :84 := function_of c v

instance [has_zero_symbol L] : has_zero (Herbrand T i) := ⟨function_of has_zero_symbol.zero finitary.nil⟩

instance [has_succ_symbol L] : has_succ (Herbrand T i) := ⟨λ h, function_of has_succ_symbol.succ ‹h›⟩

instance [has_add_symbol L] : has_add (Herbrand T i) := ⟨λ h₁ h₂, function_of has_add_symbol.add ‹h₁, h₂›⟩

instance [has_mul_symbol L] : has_mul (Herbrand T i) := ⟨λ h₁ h₂, function_of has_mul_symbol.mul ‹h₁, h₂›⟩

def predicate_of {n} (p : L.pr n) : finitary (Herbrand T i) n → Prop :=
λ v, fol.Herbrand.lift_on_finitary v (λ u : finitary (term L) n, T^i ⊢ formula.app p u)
  $ λ v₁ v₂ eqs, by simp[of_eq_of];
  exact ⟨λ h, provable.predicate_of_equiv p h eqs, λ h, provable.predicate_of_equiv p h (λ i, provable.eq_symm (eqs i))⟩

def Structure (T : Theory L) : Structure L := ⟨Herbrand T 0, ⟨⟦#0⟧ᴴ⟩, @function_of _ T 0, @predicate_of _ T 0⟩

notation `𝔗[`T`]` := Structure T

theorem eq_of_provable_equiv {t₁ t₂} : T^i ⊢ t₁ =' t₂ ↔ (⟦t₁⟧ᴴ : Herbrand T i) = ⟦t₂⟧ᴴ := by simp[of_eq_of]

theorem eq_of_provable_equiv_0 {t₁ t₂} : T ⊢ t₁ =' t₂ ↔ (⟦t₁⟧ᴴ : Herbrand T 0) = ⟦t₂⟧ᴴ := by simp[of_eq_of]

variables (T) (i)

lemma predicate_of_iff {n} (r : L.pr n) (v : finitary (term L) n) :
  predicate_of r (λ j, (⟦v j⟧ᴴ : Herbrand T i)) ↔ T^i ⊢ formula.app r v :=
by simp[predicate_of]

variables {T} {i}

instance [has_le_symbol L] : has_le (Herbrand T i) := ⟨λ h₁ h₂, predicate_of has_le_symbol.le ‹h₁, h₂›⟩

lemma le_iff_provable_le [has_le_symbol L] {t₁ t₂ : term L} : T^i ⊢ t₁ ≼ t₂ ↔ (⟦t₁⟧ᴴ : Herbrand T i) ≤ ⟦t₂⟧ᴴ :=
by simpa[has_le.le] using iff.symm (predicate_of_iff T i (has_le_symbol.le : L.pr 2) ‹t₁, t₂›)

lemma le_iff_provable_le_0 [has_le_symbol L] {t₁ t₂ : term L} : T ⊢ t₁ ≼ t₂ ↔ (⟦t₁⟧ᴴ : Herbrand T 0) ≤ ⟦t₂⟧ᴴ :=
by simpa[has_le.le] using iff.symm (predicate_of_iff T 0 (has_le_symbol.le : L.pr 2) ‹t₁, t₂›)

section
variables (f : term L → formula L) [formula.abberavation₁ f]

def abberavation₁ (h : Herbrand T i) : Prop :=
fol.Herbrand.lift_on h (λ t, T^i ⊢ f t)
(λ t u h, by { simp, suffices : T ^ i ⊢ (f #0).rew (t ⌢ ı) ↔ T ^ i ⊢ (f #0).rew (u ⌢ ı), by simpa using this,
  refine provable.iff_of_eqs (λ n, by rcases n; simp[h]) _ })

variables (T) (i)

lemma abberavation₁_iff (t : term L) :
  abberavation₁ f (⟦t⟧ᴴ : Herbrand T i) ↔ T^i ⊢ f t :=
by simp[abberavation₁]

lemma iff_abberavation₁ [has_le_symbol L] (t : term L) : T^i ⊢ f t ↔ abberavation₁ f (⟦t⟧ᴴ : Herbrand T i) :=
iff.symm (abberavation₁_iff T i f t)

lemma iff_abberavation₁_0 [has_le_symbol L] (t : term L) : T ⊢ f t ↔ abberavation₁ f (⟦t⟧ᴴ : Herbrand T 0) :=
by simpa using iff_abberavation₁ T 0 f t

end

section
variables (f : term L → term L → formula L) [formula.abberavation₂ f]

def abberavation₂ (h₁ h₂ : Herbrand T i) : Prop :=
fol.Herbrand.lift_on₂ h₁ h₂ (λ t u, T^i ⊢ f t u)
(λ t₁ t₂ u₁ u₂ h₁ h₂, by { simp,
  suffices : T ^ i ⊢ (f #0 #1).rew (t₁ ⌢ t₂ ⌢ ı) ↔ T ^ i ⊢ (f #0 #1).rew (u₁ ⌢ u₂ ⌢ ı), by simpa using this,
  refine provable.iff_of_eqs (λ n, by {rcases n; simp*; rcases n; simp*}) _ })

variables (T) (i)

lemma abberavation₂_iff (t u : term L) :
  abberavation₂ f (⟦t⟧ᴴ : Herbrand T i) ⟦u⟧ᴴ ↔ T^i ⊢ f t u :=
by simp[abberavation₂]

variables {f} {T} {i}

lemma iff_abberavation₂ [has_le_symbol L] {t u : term L} : T^i ⊢ f t u ↔ abberavation₂ f (⟦t⟧ᴴ : Herbrand T i) ⟦u⟧ᴴ :=
iff.symm (abberavation₂_iff T i f t u)

lemma iff_abberavation₂_0 [has_le_symbol L] {t u : term L} : T ⊢ f t u ↔ abberavation₂ f (⟦t⟧ᴴ : Herbrand T 0) ⟦u⟧ᴴ :=
by simpa using @iff_abberavation₂ _ T 0

end

theorem constant_term (c : L.fn 0) (v : finitary (term L) 0):
  (⟦❨c❩ v⟧ᴴ : Herbrand T i) = function_of c finitary.nil := by simp[function_of, show v = finitary.nil, by ext; simp]

@[simp] theorem zero_eq_zero [has_zero_symbol L] :
  (⟦(0 : term L)⟧ᴴ : Herbrand T i) = 0 := by unfold has_zero.zero; simp[function_of]

@[simp] theorem succ_eq_succ [has_succ_symbol L] (t : term L) :
  (⟦Succ t⟧ᴴ : Herbrand T i) = Succ ⟦t⟧ᴴ := by unfold has_succ.succ; simp[function_of]

@[simp] theorem numeral_eq_numeral [has_zero_symbol L] [has_succ_symbol L] (n : ℕ) :
  (⟦(n˙ : term L)⟧ᴴ : Herbrand T i) = numeral n :=
by induction n; simp[*,numeral]

@[simp] theorem add_eq_add [has_add_symbol L] (t u : term L) :
  (⟦t + u⟧ᴴ : Herbrand T i) = ⟦t⟧ᴴ + ⟦u⟧ᴴ := by unfold has_add.add; simp[function_of]

@[simp] theorem mul_eq_mul [has_mul_symbol L] (t u : term L) :
  (⟦t * u⟧ᴴ : Herbrand T i) = ⟦t⟧ᴴ * ⟦u⟧ᴴ := by unfold has_mul.mul; simp[function_of]

def pow : Herbrand T i → Herbrand T (i+1) :=
λ h, Herbrand.lift_on h (λ u, ⟦u^1⟧ᴴ : term L → Herbrand T (i+1)) $
λ t₁ t₂ hyp, by { simp[Herbrand.of_eq_of, ←Theory.pow_add] at*,
  rw [show ((t₁^1) =' (t₂^1): formula L) = (t₁ =' t₂)^1, by simp, provable.sf_itr_sf_itr], exact hyp }

lemma is_sentence_pow {t : term L} (a : t.arity = 0) :
  (⟦t⟧ᴴ : Herbrand T i).pow = ⟦t⟧ᴴ := by simp[pow, Herbrand.of_eq_of, a]

@[simp] lemma constant_pow (c : L.fn 0) (f : finitary (Herbrand T i) 0) :
  (H❨c❩ f : Herbrand T i).pow = (H❨c❩ finitary.nil : Herbrand T (i + 1)) := is_sentence_pow (by simp)

@[simp] theorem zero_pow [has_zero_symbol L] :
  (0 : Herbrand T i).pow = 0 := by unfold has_zero.zero; simp

@[simp] theorem succ_pow [has_succ_symbol L] (h : Herbrand T i) :
  (Succ h).pow = Succ h.pow :=
by { induction h using fol.Herbrand.ind_on,
     simp[pow, ←succ_eq_succ _, -succ_eq_succ] }

@[simp] theorem numeral_pow [has_zero_symbol L] [has_succ_symbol L] (n : ℕ) :
  (numeral n : Herbrand T i).pow = numeral n :=
by induction n; simp[*,numeral, succ_pow]

@[simp] theorem add_pow [has_add_symbol L] (h₁ h₂ : Herbrand T i) :
  (h₁ + h₂).pow = h₁.pow + h₂.pow :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
    simp[pow, ←add_eq_add _ _, -add_eq_add] }

@[simp] theorem mul_pow [has_mul_symbol L] (h₁ h₂ : Herbrand T i) :
  (h₁ * h₂).pow = h₁.pow * h₂.pow :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
    simp[pow, ←mul_eq_mul _ _, -mul_eq_mul] }

@[simp] def sf_simp (t : term L) (j : ℕ) : (⟦t⟧ᴴ : Herbrand T i).pow = ⟦t^1⟧ᴴ := rfl

def var (n : ℕ) : Herbrand T i := ⟦#n⟧ᴴ
prefix `♯`:max := var

@[simp] lemma var_eq (n : ℕ) : (⟦#n⟧ᴴ : Herbrand T i) = ♯n := rfl
lemma var_def (n : ℕ) : ♯n = (⟦#n⟧ᴴ : Herbrand T i) := rfl

@[simp] lemma var_pow (n : ℕ) : (♯n : Herbrand T i).pow= ♯(n + 1) := rfl

namespace proper

@[simp] def subst_sf_H_aux [proper : proper_Theory T] (t : term L) :
  Herbrand T (i + 1) → Herbrand T i :=
λ h, Herbrand.lift_on h (λ u, ⟦u.rew ı[i ⇝ t]⟧ᴴ : term L → Herbrand T i) $
λ t₁ t₂ hyp, by { simp[Herbrand.of_eq_of] at*, exact provable.pow_subst' i hyp t }

@[simp] def subst_sf_H_aux_inv (t : term L) :
  Herbrand T (i + 1) → Herbrand T i :=
λ h, Herbrand.lift_on h (λ u, ⟦u.rew ı[0 ⇝ t]⟧ᴴ : term L → Herbrand T i) $
λ t₁ t₂ hyp, by { simp[Herbrand.of_eq_of] at*,
  have := (provable.generalize hyp) ⊚ t, simp at this, exact this }

variables [proper_Theory T]

def subst_sf_H : Herbrand T i → Herbrand T (i+1) → Herbrand T i :=
λ t h, Herbrand.lift_on t (λ t, subst_sf_H_aux t h : term L → Herbrand T i) $
λ t₁ t₂ hyp,
by { induction h using fol.Herbrand.ind_on,
     simp[Herbrand.of_eq_of] at*,
     refine provable.equal_rew_equal (ı[i ⇝ t₁]) (ı[i ⇝ t₂]) (λ m, _) h,
     have C : m < i ∨ m = i ∨ i < m, from trichotomous m i,
     cases C,
     { simp[C] }, cases C; simp[C], exact hyp }

infix ` ⊳ᴴ ` :90  := subst_sf_H

@[simp] lemma subst_sf_H_is_sentence (h : Herbrand T i) {t : term L} (a : t.arity = 0) :
  h ⊳ᴴ (⟦t⟧ᴴ : Herbrand T (i+1)) = ⟦t⟧ᴴ :=
by { induction h using fol.Herbrand.ind_on, simp[subst_sf_H, Herbrand.of_eq_of, a] }

@[simp] lemma subst_sf_H_var_eq (h : Herbrand T i) :
  h ⊳ᴴ ♯i = h :=
by { induction h using fol.Herbrand.ind_on, simp[-var_eq, subst_sf_H, Herbrand.of_eq_of, var_def] }

@[simp] lemma subst_sf_H_var_lt (h : Herbrand T i) (j : ℕ) (eqn : j < i) :
  h ⊳ᴴ ♯j = ♯j :=
by { induction h using fol.Herbrand.ind_on, simp[-var_eq, subst_sf_H, Herbrand.of_eq_of, var_def, eqn] }

@[simp] lemma subst_sf_H_var_gt (h : Herbrand T i) (j : ℕ) (eqn : i < j) :
  h ⊳ᴴ ♯j = ♯(j - 1) :=
by { induction h using fol.Herbrand.ind_on, simp[-var_eq, subst_sf_H, Herbrand.of_eq_of, var_def, eqn] }

end proper

lemma subst_eq [proper_Theory T] (t : term L) :
  (⟦t.rew ı[i ⇝ t]⟧ᴴ : Herbrand T i) = ⟦t⟧ᴴ ⊳ᴴ ⟦t⟧ᴴ := rfl

@[simp] lemma pow_eq (t : term L) :
  (⟦t^1⟧ᴴ : Herbrand T (i + 1)) = pow ⟦t⟧ᴴ := rfl

lemma pow_def (t : term L) :
  pow ⟦t⟧ᴴ = (⟦t^1⟧ᴴ : Herbrand T (i + 1)) := rfl

end Herbrand

lemma empty_has_Structure : ∃ 𝔄 : Structure L, 𝔄 ⊧ (∅ : Theory L) :=
⟨𝔗[∅], λ p h, by { exfalso, refine set.not_mem_empty p h }⟩

theorem empty_consistent : Theory.consistent (∅ : Theory L) := @Structure_consistent L 𝔗[∅] ∅
(λ p h, by { exfalso, refine set.not_mem_empty p h })

@[reducible] def Lindenbaum : Type u := axiomatic_classical_logic.lindenbaum (T^i)

notation `⟦`p`⟧ᴸ` :max := @classical_logic.to_quo _ _ ((⊢) _) _ p

namespace Lindenbaum
open provable Herbrand axiomatic_classical_logic' axiomatic_classical_logic
variables {T} {i}

instance : boolean_algebra (Lindenbaum T i) := axiomatic_classical_logic.lindenbaum.boolean_algebra _

@[simp] lemma neg_eq (p : formula L) : (⟦∼p⟧ᴸ : Lindenbaum T i) = ⟦p⟧ᴸᶜ := rfl
lemma neg_def (p : formula L) : (⟦p⟧ᴸᶜ : Lindenbaum T i) = ⟦∼p⟧ᴸ := rfl

@[simp] lemma and_eq (p q : formula L) : (⟦p ⊓ q⟧ᴸ : Lindenbaum T i) = ⟦p⟧ᴸ ⊓ ⟦q⟧ᴸ := rfl
lemma inf_def (p q : formula L) : (⟦p⟧ᴸ ⊓ ⟦q⟧ᴸ : Lindenbaum T i) = ⟦p ⊓ q⟧ᴸ := rfl

@[simp] lemma or_eq (p q : formula L) : (⟦p ⊔ q⟧ᴸ : Lindenbaum T i) = ⟦p⟧ᴸ ⊔ ⟦q⟧ᴸ := rfl
lemma sup_def (p q : formula L) : (⟦p⟧ᴸ ⊔ ⟦q⟧ᴸ : Lindenbaum T i) = ⟦p ⊔ q⟧ᴸ := rfl

@[simp] lemma top_eq : (⟦⊤⟧ᴸ : Lindenbaum T i) = ⊤ := rfl
lemma top_def : (⊤ : Lindenbaum T i) = ⟦⊤⟧ᴸ := rfl

@[simp] lemma bot_eq : (⟦⊥⟧ᴸ : Lindenbaum T i) = ⊥ := rfl
lemma bot_def : (⊥ : Lindenbaum T i) = ⟦⊥⟧ᴸ := rfl

@[simp]
protected lemma of_eq_of {p q : formula L} : (⟦p⟧ᴸ : Lindenbaum T i) = ⟦q⟧ᴸ ↔ T^i ⊢ p ⟷ q :=
by simp[formula.equiv, quotient.eq']

def predicate_of {n} (p : L.pr n) : finitary (Herbrand T i) n → Lindenbaum T i :=
λ v, fol.Herbrand.lift_on_finitary v (λ u : finitary (term L) n, ⟦formula.app p u⟧ᴸ)
  $ λ v₁ v₂ eqs, by simp; exact equiv_predicate_of_equiv p eqs

notation `L❴` f `❵` := predicate_of f

instance [has_le_symbol L] : has_preceq (Herbrand T i) (Lindenbaum T i) := ⟨λ h₁ h₂, predicate_of has_le_symbol.le ‹h₁, h₂›⟩

instance [has_mem_symbol L] : has_elem (Herbrand T i) (Lindenbaum T i) := ⟨λ h₁ h₂, predicate_of has_mem_symbol.mem ‹h₁, h₂›⟩

@[simp] theorem predicate_of_app_1_iff {p : L.pr 1} {v : finitary (term L) 1} :
  (⟦❴p❵ v⟧ᴸ : Lindenbaum T i) = L❴p❵ ‹⟦v 0⟧ᴴ› := by simp[predicate_of, show ‹v 0› = v, by ext; simp]

@[simp] theorem predicate_of_app_2_iff {p : L.pr 2} {v : finitary (term L) 2} :
  (⟦❴p❵ v⟧ᴸ : Lindenbaum T i) = L❴p❵ ‹⟦v 0⟧ᴴ, ⟦v 1⟧ᴴ› := by simp[predicate_of, show ‹v 0, v 1› = v, by ext; simp]

@[simp] theorem le_iff_le [has_le_symbol L] (t u : term L) :
  (⟦t ≼ u⟧ᴸ : Lindenbaum T i) = ((⟦t⟧ᴴ : Herbrand T i) ≼ ⟦u⟧ᴴ) := by unfold has_preceq.preceq; simp

@[simp] theorem mem_iff_mem [has_mem_symbol L] (t u : term L) :
  (⟦t ∊ u⟧ᴸ : Lindenbaum T i) = ((⟦t⟧ᴴ : Herbrand T i) ∊ ⟦u⟧ᴴ) := by unfold has_elem.elem; simp

def equal : Herbrand T i → Herbrand T i → Lindenbaum T i :=
λ h₁ h₂, fol.Herbrand.lift_on₂ h₁ h₂ (λ t₁ t₂, (⟦t₁ =' t₂⟧ᴸ : Lindenbaum T i)) $
λ t₁ t₂ u₁ u₂ eqn₁ eqn₂, by simp; exact equiv_eq_of_equiv eqn₁ eqn₂

instance : has_eq (Herbrand T i) (Lindenbaum T i) := ⟨equal⟩

local infix ` ='ᴸ `:80 := ((=') : Herbrand T i → Herbrand T i → Lindenbaum T i)

@[simp] lemma equal_eq (t u : term L) : ⟦t =' u⟧ᴸ = (⟦t⟧ᴴ ='ᴸ ⟦u⟧ᴴ) := rfl

lemma equal_def (t u : term L) : (⟦t⟧ᴴ ='ᴸ ⟦u⟧ᴴ) = ⟦t =' u⟧ᴸ := rfl

section
variables (f : term L → formula L) [formula.abberavation₁ f]

def abberavation₁ (h : Herbrand T i) : Lindenbaum T i :=
fol.Herbrand.lift_on h (λ t, (⟦f t⟧ᴸ : Lindenbaum T i))
(λ t u h, by { simp, suffices : T^i ⊢ (f #0).rew (t ⌢ ı) ⟷ (f #0).rew (u ⌢ ı), by simpa using this,
  refine provable.equal_rew_iff _ _, intros n, rcases n; simp* })

variables (T) (i)

lemma abberavation₁_def (t : term L) : abberavation₁ f (⟦t⟧ᴴ : Herbrand T i) = ⟦f t⟧ᴸ :=
by simp[abberavation₁]

@[simp] lemma eq_abberavation₁ [has_le_symbol L] (t : term L) : (⟦f t⟧ᴸ : Lindenbaum T i) = abberavation₁ f ⟦t⟧ᴴ :=
eq.symm (abberavation₁_def T i f t)

end

section
variables (f : term L → term L → formula L) [formula.abberavation₂ f]

def abberavation₂ (h₁ h₂ : Herbrand T i) : Lindenbaum T i :=
fol.Herbrand.lift_on₂ h₁ h₂ (λ t u, (⟦f t u⟧ᴸ : Lindenbaum T i))
(λ t₁ t₂ u₁ u₂ h₁ h₂, by { simp, suffices : T^i ⊢ (f #0 #1).rew (t₁ ⌢ t₂ ⌢ ı) ⟷ (f #0 #1).rew (u₁ ⌢ u₂ ⌢ ı), by simpa using this,
  refine provable.equal_rew_iff _ _, intros n, rcases n; simp*, rcases n; simp* })

variables (T) (i)

lemma abberavation₂_def (t u : term L) : abberavation₂ f (⟦t⟧ᴴ : Herbrand T i) ⟦u⟧ᴴ = ⟦f t u⟧ᴸ :=
by simp[abberavation₂]

@[simp] lemma eq_abberavation₂ [has_le_symbol L] (t u : term L) : (⟦f t u⟧ᴸ : Lindenbaum T i) = abberavation₂ f ⟦t⟧ᴴ ⟦u⟧ᴴ :=
eq.symm (abberavation₂_def T i f t u)

end

def univ : Lindenbaum T (i+1) → Lindenbaum T i :=
λ p, classical_logic.lindenbaum.lift_on p (λ p, (⟦∀.p⟧ᴸ : Lindenbaum T i)) $
λ p₁ p₂ hyp, by simp at hyp ⊢; exact equiv_univ_of_equiv hyp

instance : has_univ_quantifier' (Lindenbaum T) := ⟨@univ L T⟩

@[simp] lemma univ_eq (p : formula L) : ⟦∀.p⟧ᴸ = (∀' (⟦p⟧ᴸ : Lindenbaum T (i + 1)) : Lindenbaum T i) := rfl

lemma univ_def (p : formula L) : (∀' (⟦p⟧ᴸ : Lindenbaum T (i + 1)) : Lindenbaum T i) = ⟦∀.p⟧ᴸ := rfl

def exist : Lindenbaum T (i+1) → Lindenbaum T i :=
λ p, classical_logic.lindenbaum.lift_on p (λ p, (⟦∃.p⟧ᴸ : Lindenbaum T i)) $
λ p₁ p₂ hyp, by simp at hyp ⊢; exact equiv_ex_of_equiv hyp

instance : has_exists_quantifier' (Lindenbaum T) := ⟨@exist L T⟩

@[simp] lemma exist_eq (p : formula L) : ⟦∃.p⟧ᴸ = (∃' (⟦p⟧ᴸ : Lindenbaum T (i + 1)) : Lindenbaum T i) := rfl

lemma exist_def (p : formula L) : (∃' (⟦p⟧ᴸ : Lindenbaum T (i + 1)) : Lindenbaum T i) = ⟦∃.p⟧ᴸ := rfl

@[simp] lemma equal_refl {h : Herbrand T i}  : h ='ᴸ h = ⊤ :=
by { induction h using fol.Herbrand.ind_on;
     rw [←equal_eq, ←top_eq], simp [-equal_eq, -top_eq, axiomatic_classical_logic'.iff_equiv] }

lemma equal_symm (h₁ h₂ : Herbrand T i) : (h₁ ='ᴸ h₂) = (h₂ =' h₁) :=
by { induction h₁ using fol.Herbrand.ind_on,
     induction h₂ using fol.Herbrand.ind_on,
     rw [←equal_eq, ←equal_eq], simp [-equal_eq, axiomatic_classical_logic'.iff_equiv],
     refine ⟨by { have := (@eq_symmetry _ (T^i)) ⊚ h₂ ⊚ h₁, simp at this, exact this },
       by { have := (@eq_symmetry _ (T^i)) ⊚ h₁ ⊚ h₂, simp at this, exact this }⟩ }

lemma equal_iff {h₁ h₂ : Herbrand T i} {p : L.pr 1} : h₁ ='ᴸ h₂ = ⊤ ↔ h₁ = h₂ :=
by { induction h₁ using fol.Herbrand.ind_on, induction h₂ using fol.Herbrand.ind_on,
     rw [←equal_eq, ←top_eq], simp [-equal_eq, -top_eq, axiomatic_classical_logic'.iff_equiv] }

def pow : Lindenbaum T i → Lindenbaum T (i+1) :=
λ p, classical_logic.lindenbaum.lift_on p (λ p, (⟦p^1⟧ᴸ : Lindenbaum T (i+1))) $
λ p₁ p₂ hyp, by { simp[contrapose, ←Theory.pow_add, -axiomatic_classical_logic'.iff_equiv] at*,
  exact sf_itr_sf_itr.mpr hyp }

@[simp] lemma pow_eq (p : formula L) : (⟦p^1⟧ᴸ : Lindenbaum T (i + 1)) = pow ⟦p⟧ᴸ := rfl

lemma pow_def (p : formula L) : pow ⟦p⟧ᴸ = (⟦p^1⟧ᴸ : Lindenbaum T (i + 1)) := rfl

lemma is_sentence_pow {p : formula L} (a : is_sentence p) :
  pow (⟦p⟧ᴸ : Lindenbaum T i) = ⟦p⟧ᴸ := by rw [←pow_eq]; simp[-pow_eq, a]

@[simp] lemma pow_compl (l : Lindenbaum T i) : pow (lᶜ) = (pow l)ᶜ :=
by { induction l using classical_logic.lindenbaum.ind_on,
     simp only [←pow_eq, ←neg_eq], simp[-pow_eq, -neg_eq] }

@[simp] lemma pow_sup (l m : Lindenbaum T i) : pow (l ⊔ m) = (pow l) ⊔ (pow m) :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction m using classical_logic.lindenbaum.ind_on,
     simp[sup_def, pow_def, -pow_eq, -or_eq] }

@[simp] lemma pow_inf (l m : Lindenbaum T i) : pow (l ⊓ m) = (pow l) ⊓ (pow m) :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction m using classical_logic.lindenbaum.ind_on,
     simp[inf_def, pow_def, -pow_eq, -and_eq] }

@[simp] lemma prod_top : (∀' (⊤ : Lindenbaum T (i+1)) : Lindenbaum T i) = ⊤ :=
by { simp only [←top_eq, ←univ_eq],
     simp[-top_eq, -univ_eq, axiomatic_classical_logic'.iff_equiv],
     apply provable.generalize, simp }

lemma prenex_ex_neg (l : Lindenbaum T (i+1)) : (∃' l : Lindenbaum T i)ᶜ = ∀' lᶜ :=
by { induction l using classical_logic.lindenbaum.ind_on,
     simp only [neg_def, exist_def, univ_def],
     simp[-neg_eq, -exist_eq, -univ_eq, -axiomatic_classical_logic'.iff_equiv,
          has_exists_quantifier.ex, formula.ex] }

lemma prenex_fal_neg (l : Lindenbaum T (i+1)) : (∀' l : Lindenbaum T i)ᶜ = ∃' lᶜ :=
by { have := prenex_ex_neg lᶜ, simp[-prenex_ex_neg] at this, simp[←this] }

lemma prenex_fal_or_left {l : Lindenbaum T (i+1)} {k : Lindenbaum T i} :
  (∀' l) ⊔ k = ∀' l ⊔ k.pow :=
begin
  induction l using classical_logic.lindenbaum.ind_on with p,
  induction k using classical_logic.lindenbaum.ind_on with q,
  simp[sup_def, pow_def, univ_def, -or_eq, -pow_eq, -univ_eq, axiomatic_classical_logic'.iff_equiv], split,
  { refine (deduction.mp $ generalize $ contrapose.mp _), simp [←sf_dsb],
    have lmm₁ : ⤊(T^i) +{ ∼(∀.p)^1 ⟶ q^1 } ⊢ ∼q^1 ⟶ (∀.p)^1, { refine contrapose.mp _, simp },
    have lmm₂ : ⤊(T^i) +{ ∼(∀.p)^1 ⟶ q^1 } ⊢ (∀.p)^1 ⟶ p,
    { suffices : ⤊(T^i) +{ ∼(∀.p)^1 ⟶ q^1 } ⊢ (∀.p)^1 ⟶ (p.rew $ (λ x, #(x + 1))^1).rew ı[0 ⇝ #0],
      { simp[formula.nested_rew] at this, exact this },
      exact specialize _ },
    exact imply_trans lmm₁ lmm₂ },
  { refine (deduction.mp $ contrapose.mp _), simp[←sf_dsb],
    refine deduction.mp (generalize _), simp[←sf_dsb],
    suffices : ⤊(T^i)+{(∀.(∼p ⟶ q^1))^1} ⊢ ∼q^1 ⟶ p, { from deduction.mpr this },
    have :     ⤊(T^i)+{(∀.(∼p ⟶ q^1))^1} ⊢ ∼p ⟶ q^1,
    { have : ⤊(T^i)+{(∀. (∼p ⟶ q^1))^1} ⊢ (∀. (∼p ⟶ q^1))^1, { simp },
      have lmm₁ := fal_subst this #0, simp at lmm₁,
      simp[formula.nested_rew] at lmm₁,
      exact lmm₁ },
    refine contrapose.mp _, simp[this] }
end

lemma prenex_fal_or_right {l : Lindenbaum T i} {k : Lindenbaum T (i+1)} :
  l ⊔ ∀' k = ∀' (l.pow ⊔ k) :=
by simp[show l ⊔ (∀' k) = (∀' k) ⊔ l, from sup_comm, prenex_fal_or_left,
        show k ⊔ l.pow = l.pow ⊔ k, from sup_comm]

lemma prenex_fal_and_left {l : Lindenbaum T (i+1)} {k : Lindenbaum T i} :
  (∀' l) ⊓ k = ∀' l ⊓ k.pow :=
begin
  induction l using classical_logic.lindenbaum.ind_on,
  induction k using classical_logic.lindenbaum.ind_on,
  simp[inf_def, pow_def, univ_def, -and_eq, -pow_eq, -univ_eq, axiomatic_classical_logic'.iff_equiv], split,
  { refine (deduction.mp $ generalize _), rw [←sf_dsb], simp[axiom_and],
    have : ⤊(T^i) +{ (∀. l)^1 } +{ k^1 } ⊢ (∀.l)^1, simp,
    have := fal_subst this #0, simp[formula.nested_rew] at this,
    exact this },
  { refine deduction.mp _, simp, split,
    { refine generalize _, simp[←sf_dsb],
      have : ⤊(T^i) +{ (∀.l ⊓ (k^1))^1 } ⊢ (∀.l ⊓ (k^1))^1, simp,
      have := fal_subst this #0, simp[formula.nested_rew] at this, simp* at* },
    { have : (T^i) +{ ∀.l ⊓ (k^1) } ⊢ ∀.l ⊓ (k^1), simp,
      have := fal_subst this #0, simp* at * } }
end

lemma prenex_ex_or_left {l : Lindenbaum T (i+1)} {k : Lindenbaum T i} :
  (∃' l) ⊔ k = ∃' (l ⊔ k.pow) :=
by rw ← compl_inj_iff; simp[-compl_inj_iff, prenex_ex_neg, prenex_fal_and_left]

lemma prenex_ex_and_left {l : Lindenbaum T (i+1)} {k : Lindenbaum T i} :
  (∃' l) ⊓ k = ∃' (l ⊓ k.pow) :=
by rw ← compl_inj_iff; simp[-compl_inj_iff, prenex_ex_neg, prenex_fal_or_left]

lemma or_neg_comm (l : Lindenbaum T i) (k : Lindenbaum T i) :
  l ⊔ kᶜ = kᶜ ⊔ l := sup_comm

lemma or_fal_comm (l : Lindenbaum T i) (k : Lindenbaum T (i + 1)) :
  l ⊔ (∀' k) = (∀' k) ⊔ l := sup_comm

lemma or_ex_comm (l : Lindenbaum T i) (k : Lindenbaum T (i + 1)) :
  l ⊔ (∃' k) = (∃' k) ⊔ l := sup_comm

namespace proper

variables [proper_Theory T]

@[simp] def subst_sf_L_aux (t : term L) :
  Lindenbaum T (i+1) → Lindenbaum T i :=
λ p, classical_logic.lindenbaum.lift_on p (λ p, (⟦p.rew (ı[i ⇝ t])⟧ᴸ : Lindenbaum T i)) $
λ p₁ p₂ hyp, by { simp at*,
    exact provable.pow_subst' i hyp t }

def subst_sf_L : Herbrand T i → Lindenbaum T (i+1) → Lindenbaum T i :=
λ t l, Herbrand.lift_on t (λ t, subst_sf_L_aux t l) $
λ t₁ t₂ hyp, by { induction l using classical_logic.lindenbaum.ind_on,
  simp at*,
  refine equal_rew_iff (λ m, _) l,
  have C : m < i ∨ m = i ∨ i < m, from trichotomous _ _,
  cases C,
  { simp[C] }, cases C; simp[C],
  { refine hyp } }
infixr ` ⊳ `:90  := subst_sf_L

lemma fal_le_subst (l : Lindenbaum T (i + 1)) (h : Herbrand T i) : ∀' (♯0 ⊳ l.pow) ≤ h ⊳ l :=
begin
  induction l using classical_logic.lindenbaum.ind_on with p,
  induction h using fol.Herbrand.ind_on with t,
  have : T^i ⊢ ∀.(p^1).rew ı[(i + 1) ⇝ #0] ⟶ ((p^1).rew ı[(i + 1) ⇝ #0]).rew ı[0 ⇝ t],
    from @specialize _ (T^i) ((p^1).rew ı[(i + 1) ⇝ #0]) t,
  have eqn : (((p^1).rew ı[(i + 1) ⇝ #0]).rew ı[0 ⇝ t]) = p.rew ı[i ⇝ t],
  { simp[formula.nested_rew, formula.pow_eq], congr,
    funext x, have C : i < x ∨ i = x ∨ x < i, exact trichotomous i x,
    cases C, { simp[C, pos_of_gt C] }, cases C;
    simp[C] },
  rw eqn at this,
  exact this,
end

lemma fal_le_subst0 (l : Lindenbaum T 1) (h) : ∀' l ≤ (h ⊳ l) :=
begin
  induction l using classical_logic.lindenbaum.ind_on with p,
  induction h using fol.Herbrand.ind_on with t,
  simp only [←univ_eq],
  simp[-univ_eq, subst_sf_L, classical_logic.lindenbaum.le_def],
end

lemma subst_sf_L_le_ex (l : Lindenbaum T 1) (h) : h ⊳ l ≤ ∃' l :=
begin
  induction l using classical_logic.lindenbaum.ind_on,
  induction h using fol.Herbrand.ind_on,
  simp[exist_def, -exist_eq, subst_sf_L, classical_logic.lindenbaum.le_def],
  refine contrapose.mp _, simp[has_exists_quantifier.ex, formula.ex],
  rw (show ∼(l.rew ı[0 ⇝ h]) = (∼l).rew ı[0 ⇝ h], by simp),
  exact specialize _
end

lemma le_fal_le_fal {l m : Lindenbaum T (i + 1)} :
  l ≤ m → (∀' l : Lindenbaum T i) ≤ ∀' m :=
begin
  induction l using classical_logic.lindenbaum.ind_on,
  induction m using classical_logic.lindenbaum.ind_on,
  simp[subst_sf_L, pow_def, classical_logic.lindenbaum.le_def],
  { intros h, refine univ_K _ _ ⨀ (generalize h) },
end

@[simp] lemma dummy_fal (l : Lindenbaum T i) : ∀' pow l = l :=
by { symmetry,
     induction l using classical_logic.lindenbaum.ind_on,
     simp only [←univ_eq, ←pow_eq], simp[-univ_eq, -pow_eq],
     exact @provable.dummy_fal_quantifir _ (T^i) l }

lemma pow_le_le_fal {l : Lindenbaum T i} {m : Lindenbaum T (i + 1)} :
  l.pow ≤ m → l ≤ ∀' m :=
by { have := @le_fal_le_fal _ _ _ _ l.pow m, simp at this, exact this }

@[simp] lemma subst_sf_L_compl (h : Herbrand T i) (l : Lindenbaum T (i+1)) :
  h ⊳ (lᶜ)= (h ⊳ l)ᶜ :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction h using fol.Herbrand.ind_on,
     simp[neg_def, subst_sf_L, -neg_eq] }

@[simp] lemma subst_sf_L_and (h : Herbrand T i) (l m : Lindenbaum T (i+1)) :
  h ⊳ (l ⊓ m) = h ⊳ l ⊓ h ⊳ m :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction m using classical_logic.lindenbaum.ind_on,
     induction h using fol.Herbrand.ind_on,
     simp[inf_def, subst_sf_L, -and_eq] }

@[simp] lemma subst_sf_L_or (h : Herbrand T i) (l m : Lindenbaum T (i+1)) :
  h ⊳ (l ⊔ m) = h ⊳ l ⊔ h ⊳ m :=
by { induction l using classical_logic.lindenbaum.ind_on, induction m using classical_logic.lindenbaum.ind_on,
     induction h using fol.Herbrand.ind_on,
     simp[-or_eq, subst_sf_L, classical_logic.lindenbaum.sup_def] }

@[simp] lemma subst_sf_L_equal (h₁ : Herbrand T i) (h₂ h₃ : Herbrand T (i+1)) :
  h₁ ⊳ (h₂ =' h₃) = ((h₁ ⊳ᴴ h₂) =' (h₁ ⊳ᴴ h₃)) :=
by { induction h₁ using fol.Herbrand.ind_on, induction h₂ using fol.Herbrand.ind_on,
     induction h₃ using fol.Herbrand.ind_on,
     simp[-equal_eq, subst_sf_L, Herbrand.proper.subst_sf_H, Herbrand.proper.subst_sf_H_aux, equal_def] }

@[simp] lemma subst_sf_L_fal (h : Herbrand T i) (l : Lindenbaum T (i+2)) :
  h ⊳ ∀' l = ∀' (h.pow ⊳ l) :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction h using fol.Herbrand.ind_on,
     simp[subst_sf_L, univ_def, Herbrand.pow_def, -univ_eq, -Herbrand.pow_eq, subst_pow] }

@[simp] lemma subst_sf_L_ex (h : Herbrand T i) (l : Lindenbaum T (i+2)) :
  h ⊳ ∃' l = ∃' (h.pow ⊳ l) :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction h using fol.Herbrand.ind_on,
     simp[subst_sf_L, exist_def, Herbrand.pow_def, -exist_eq, -Herbrand.pow_eq, subst_pow] }

lemma subst_sf_L_is_sentence (h : Herbrand T i) {p : formula L} (a : is_sentence p) :
  h ⊳ (⟦p⟧ᴸ : Lindenbaum T (i+1)) = ⟦p⟧ᴸ :=
by { induction h using fol.Herbrand.ind_on, simp[subst_sf_L, Lindenbaum.of_eq_of, a] }

lemma ex_subst_le (l : Lindenbaum T (i + 1)) (h : Herbrand T i) : h ⊳ l ≤ ∃' (♯0 ⊳ l.pow) :=
begin
  suffices : (∃' (♯0 ⊳ pow l))ᶜ ≤ (h ⊳ l)ᶜ,
  { exact compl_le_compl_iff_le.mp this },
  simp[prenex_ex_neg, -compl_le_compl_iff_le],
  have := fal_le_subst lᶜ h, simp at this, exact this
end

@[simp] lemma pow_fal1 (l : Lindenbaum T 1) : pow (∀' l : Lindenbaum T 0) = ∀' (♯0 ⊳ pow (pow l)) :=
by { induction l using classical_logic.lindenbaum.ind_on,
     simp[univ_def, pow_def, var_def, -univ_eq, -pow_eq, -var_eq, subst_sf_L,
          formula.pow_eq, formula.nested_rew, rewriting_sf_itr.pow_eq'],
     have : (λ x, ite (x = 0) #x #(x - 1 + 1 + 1) : ℕ → term L) = (λ x, ı[(1 + 1) ⇝ #0] (x + 1 + 1)),
     { funext x, simp[slide, ı], cases x; simp[← nat.add_one] },
     simp [this] }

end proper

@[elab_as_eliminator]
protected lemma ind_on {C : Lindenbaum T i → Prop} (d : Lindenbaum T i)
  (h : ∀ p : formula L, C ⟦p⟧ᴸ) : C d :=
quotient.induction_on' d h

@[simp] lemma compl_sup_iff_le (l m : Lindenbaum T i) : lᶜ ⊔ m = ⊤ ↔ l ≤ m :=
by { induction l using classical_logic.lindenbaum.ind_on,
     induction m using classical_logic.lindenbaum.ind_on,
     simp[top_def, -top_eq, show ∼l ⊔ m = ∼∼l ⟶ m, by refl, axiomatic_classical_logic'.iff_equiv,
          neg_def, -neg_eq, sup_def, -or_eq, classical_logic.lindenbaum.le_def], }

@[simp] lemma fal_top_top : (∀' (⊤ : Lindenbaum T (i + 1)) : Lindenbaum T i) = ⊤ :=
by { simp[top_def, -top_eq, axiomatic_classical_logic'.iff_equiv, univ_def, -univ_eq],
     refine generalize (by simp) }

@[simp] lemma ex_top_top : (∃' (⊤ : Lindenbaum T (i + 1)) : Lindenbaum T i) = ⊤ :=
by { simp[top_def, -top_eq, axiomatic_classical_logic'.iff_equiv, exist_def, -exist_eq],
     refine provable.use #0 (by simp) }

theorem eq_top_of_provable {p} : T^i ⊢ p ↔ (⟦p⟧ᴸ : Lindenbaum T i) = ⊤ :=
by simp[top_def, -top_eq, axiomatic_classical_logic'.iff_equiv]

theorem eq_top_of_provable_0 {p} : T ⊢ p ↔ (⟦p⟧ᴸ : Lindenbaum T 0) = ⊤ :=
by simp[top_def, -top_eq, axiomatic_classical_logic'.iff_equiv]

protected theorem eq_of_provable_equiv {p q} : T^i ⊢ p ⟷ q ↔ (⟦p⟧ᴸ : Lindenbaum T i) = ⟦q⟧ᴸ := by simp

protected theorem eq_of_provable_equiv_0 {p q} : T ⊢ p ⟷ q ↔ (⟦p⟧ᴸ : Lindenbaum T 0) = ⟦q⟧ᴸ := by simp

theorem le_of_provable_imply {p q} : T^i ⊢ p ⟶ q ↔ (⟦p⟧ᴸ : Lindenbaum T i) ≤ ⟦q⟧ᴸ := by refl

theorem le_of_provable_imply_0 {p q} : T ⊢ p ⟶ q ↔ (⟦p⟧ᴸ : Lindenbaum T 0) ≤ ⟦q⟧ᴸ := by refl

@[simp] theorem provable_imp_eq {p q} : (⟦p ⟶ q⟧ᴸ : Lindenbaum T i) = ⟦p⟧ᴸᶜ ⊔ ⟦q⟧ᴸ := by {
  have : (⟦p ⟶ q⟧ᴸ : Lindenbaum T i) = ⟦∼p ⊔ q⟧ᴸ,
  { simp[neg_def, -neg_eq, sup_def, -or_eq, axiomatic_classical_logic'.iff_equiv],
    simp only [has_sup.sup, formula.or],
    refine ⟨deduction.mp (by { simp }), deduction.mp _⟩,
    refine imply_of_equiv (show (T^i)+{∼∼p ⟶ q} ⊢ ∼∼p ⟶ q, by simp[-dn1_iff]) _ _; simp },
  exact this }

lemma subst_eq [proper_Theory T] (p : formula L) (t : term L) :
  (⟦p.rew ı[i ⇝ t]⟧ᴸ : Lindenbaum T i) = ⟦t⟧ᴴ ⊳ ⟦p⟧ᴸ := rfl

@[simp] lemma equiv_eq_top_iff {p q} : (⟦p ⟷ q⟧ᴸ : Lindenbaum T i) = ⊤ ↔ (⟦p⟧ᴸ : Lindenbaum T i) = ⟦q⟧ᴸ :=
by simp[eq_top_of_provable]

lemma to_Herbrand {h₁ h₂ : Herbrand T i} : h₁ ='ᴸ h₂ = ⊤ ↔ h₁ = h₂ :=
by { induction h₁ using fol.Herbrand.ind_on, induction h₂ using fol.Herbrand.ind_on,
     simp[equal_def, top_def, -equal_eq, -top_eq, axiomatic_classical_logic'.iff_equiv] }

theorem eq_neg_of_provable_neg {p} : T^i ⊢ ∼p ↔ (⟦p⟧ᴸ : Lindenbaum T i) = ⊥ :=
by simp [eq_top_of_provable]

theorem eq_neg_of_provable_neg_0 {p} : T ⊢ ∼p ↔ (⟦p⟧ᴸ : Lindenbaum T 0) = ⊥ :=
@eq_neg_of_provable_neg _ T 0 p

variables (T)

lemma rew_by_axiom₁ (t u : term L) : (⟦t⟧ᴴ : Herbrand (T +{t =' u}) 0) = ⟦u⟧ᴴ :=
Herbrand.eq_of_provable_equiv_0.mp (show T +{t =' u} ⊢ t =' u, by simp)

lemma rew_by_axiom₁_inv (t u : term L) : (⟦u⟧ᴴ : Herbrand (T +{t =' u}) 0) = ⟦t⟧ᴴ :=
(rew_by_axiom₁ _ t u).symm

lemma rew_by_axiom₂ (t u : term L) {p} : (⟦t⟧ᴴ : Herbrand (T +{t =' u} +{ p }) 0) = ⟦u⟧ᴴ :=
Herbrand.eq_of_provable_equiv_0.mp (show T +{t =' u} +{ p } ⊢ t =' u, by simp)

lemma rew_by_axiom₂_inv (t u : term L) {p} : (⟦u⟧ᴴ : Herbrand (T +{t =' u} +{ p }) 0) = ⟦t⟧ᴴ :=
(rew_by_axiom₂ _ t u).symm

lemma rew_by_axiom₁_var (x : ℕ) (t : term L) : (♯x : Herbrand (T +{#x =' t}) 0) = ⟦t⟧ᴴ :=
Herbrand.eq_of_provable_equiv_0.mp (show T +{#x =' t} ⊢ #x =' t, by simp)

lemma rew_by_axiom₁_inv_var (x : ℕ) (t : term L) : (♯x : Herbrand (T +{t =' #x}) 0) = ⟦t⟧ᴴ :=
(Herbrand.eq_of_provable_equiv_0.mp (show T +{t =' #x} ⊢ t =' #x, by simp)).symm

lemma rew_by_axiom₂_var (x : ℕ) (t : term L) {p} : (♯x : Herbrand (T +{#x =' t}+{p}) 0) = ⟦t⟧ᴴ :=
Herbrand.eq_of_provable_equiv_0.mp (show T +{#x =' t}+{p} ⊢ #x =' t, by simp)

lemma rew_by_axiom₂_inv_var (x : ℕ) (t : term L) {p} : (♯x : Herbrand (T +{t =' #x}+{p}) 0) = ⟦t⟧ᴴ :=
(Herbrand.eq_of_provable_equiv_0.mp (show T +{t =' #x}+{p} ⊢ t =' #x, by simp)).symm

@[simp] lemma eq_by_axiom (t u : term L) (h : T ⊢ t =' u) : (⟦t⟧ᴴ : Herbrand T 0) = ⟦u⟧ᴴ :=
Herbrand.eq_of_provable_equiv_0.mp h

end Lindenbaum

noncomputable lemma Lindenbaum.Theory (C : Theory L) (i : ℕ) : set (Lindenbaum T i) := {l | ∃ p, p ∈ C ∧ l = ⟦p⟧ᴸ}

namespace provable
open classical_logic axiomatic_classical_logic axiomatic_classical_logic' Herbrand Lindenbaum

variables {T}

@[simp] lemma neg_fal_equiv_ex_neg (p : formula L) : T ⊢ ∼(∀.p) ⟷ ∃.∼p :=
Lindenbaum.eq_of_provable_equiv_0.mpr (by simp[prenex_fal_neg])

@[simp] lemma neg_ex_equiv_fal_neg (p : formula L) : T ⊢ ∼(∃.p) ⟷ ∀.∼p :=
Lindenbaum.eq_of_provable_equiv_0.mpr (by simp[prenex_ex_neg])

@[simp] lemma ex_imply_equiv_fal_imply (p q : formula L) : T ⊢ ((∃.p) ⟶ q) ⟷ ∀.(p ⟶ q^1) :=
Lindenbaum.eq_of_provable_equiv_0.mpr
  (by simp[prenex_fal_or_left, prenex_fal_neg, prenex_ex_neg])

@[simp] lemma fal_imply_equiv_ex_imply (p q : formula L) : T ⊢ ((∀.p) ⟶ q) ⟷ ∃.(p ⟶ q^1) :=
Lindenbaum.eq_of_provable_equiv_0.mpr
  (by simp[prenex_ex_or_left, prenex_fal_neg, prenex_ex_neg])

@[simp] lemma imply_ex_equiv_ex_imply (p q : formula L) : T ⊢ (p ⟶ ∃.q) ⟷ ∃.(p^1 ⟶ q) :=
Lindenbaum.eq_of_provable_equiv_0.mpr
  (by { simp[prenex_ex_or_left, prenex_fal_neg, prenex_ex_neg, or_ex_comm],
    rw [show to_quo q ⊔ (pow (to_quo p))ᶜ = (pow (to_quo p))ᶜ ⊔ to_quo q, from sup_comm] })

@[simp] lemma imply_fal_equiv_fal_imply (p q : formula L) : T ⊢ (p ⟶ ∀.q) ⟷ ∀.(p^1 ⟶ q) :=
Lindenbaum.eq_of_provable_equiv_0.mpr
  (by { simp[prenex_fal_or_left, prenex_fal_neg, prenex_ex_neg, or_fal_comm],
    rw [show to_quo q ⊔ (pow (to_quo p))ᶜ = (pow (to_quo p))ᶜ ⊔ to_quo q, from sup_comm] })

lemma pnf_imply_ex_iff_fal_imply₁ (p q : formula L) : T ⊢ ((∃.p) ⟶ q) ↔ T ⊢ ∀.(p ⟶ q^1) :=
by { have : T ⊢ ∃.p ⟶ q ⟷ ∀.(p ⟶ q ^ 1), { simp },
     simp[iff_equiv] at this,
     refine ⟨λ h, this.1 ⨀ h, λ h, this.2 ⨀ h⟩ }

lemma pnf_imply_fal_iff_ex_imply₁ (p q : formula L) : T ⊢ ((∀.p) ⟶ q) ↔ T ⊢ ∃.(p ⟶ q^1) :=
by { have : T ⊢ ∀.p ⟶ q ⟷ ∃.(p ⟶ q ^ 1), { simp },
     simp[iff_equiv] at this,
     refine ⟨λ h, this.1 ⨀ h, λ h, this.2 ⨀ h⟩ }

lemma imply_ex_of_fal_imply {p q : formula L} (h : T ⊢ ∀.(p ⟶ q^1)) : T ⊢ (∃.p) ⟶ q :=
by { have : T ⊢ ((∃.p) ⟶ q) ⟷ ∀.(p ⟶ q^1), { simp },
     simp[iff_equiv] at this,
     exact this.2 ⨀ h }

@[simp] lemma succ_ext [has_succ_symbol L] (t₁ t₂ : term L) :
  T ⊢ (t₁ =' t₂) ⟶ (Succ t₁ =' Succ t₂) :=
begin
  refine deduction.mp _,
  simp[eq_of_provable_equiv_0, rew_by_axiom₁]
end

@[simp] lemma add_ext [has_add_symbol L] (t₁ t₂ u₁ u₂ : term L) :
  T ⊢ (t₁ =' t₂) ⊓ (u₁ =' u₂) ⟶ (t₁ + u₁ =' t₂ + u₂) :=
begin
  refine deduction.mp _,
  simp[eq_of_provable_equiv_0, axiom_and],
  have : (⟦t₁⟧ᴴ : Herbrand (T +{ (t₁ =' t₂) }+{ (u₁ =' u₂) }) 0) = ⟦t₂⟧ᴴ,
  from eq_of_provable_equiv_0.mp (by simp),
  simp[*, rew_by_axiom₁]
end

end provable

namespace Lindenbaum

@[simp] lemma and_ext [has_add_symbol L] (t₁ t₂ u₁ u₂ : Herbrand T i) :
  (t₁ =' t₂ : Lindenbaum T i) ⊓ (u₁ =' u₂) ≤ (t₁ + u₁ =' t₂ + u₂) :=
begin
  induction t₁ using fol.Herbrand.ind_on,
  induction t₂ using fol.Herbrand.ind_on,
  induction u₁ using fol.Herbrand.ind_on,
  induction u₂ using fol.Herbrand.ind_on,
  have : T^i ⊢ (t₁ =' t₂) ⊓ (u₁ =' u₂) ⟶ (t₁ + u₁ =' t₂ + u₂), { simp },
  have := le_of_provable_imply.mp this, simp at this, exact this
end

end Lindenbaum

end fol