import tactic
import ssyt

/-

Defining "inverse_row_bump_step": one step of inverse row insertion

Given an ssyt T and natural numbers i, k, we "inverse bump" k into row i
while preserving semistandardness. In particular k goes before any existing k's
and replaces the rightmost smaller entry. (It is necessary that there exist an entry
smaller than k in row i.)

An assumption is necessary (to preserve column strictness) for this to be legal.
  [ssyt.irbs_cert]
  [ssyt.irbs_cert.legal_of_cert]

The bump position is defined using finset.max'.
  [ssyt.irbc]

The bump itself uses ssyt.legal.replace.
  [ssyt.irbs]

-/

section inverse_row_bump_column

def ssyt.irbc_strip {μ : young_diagram} (T : ssyt μ) (i val : ℕ) : finset ℕ :=
  ((finset.range $ μ.row_len i).filter (λ j, T i j < val))

lemma ssyt.irbc_strip_mem {μ : young_diagram} (T : ssyt μ) {i val j : ℕ} :
  j ∈ T.irbc_strip i val ↔ (i, j) ∈ μ ∧ T i j < val :=
by rw [ssyt.irbc_strip, finset.mem_filter, finset.mem_range, μ.mem_row_iff']

lemma ssyt.irbc_aux {μ : young_diagram} (T : ssyt μ) {i val : ℕ} :
  (T.irbc_strip i val).nonempty ↔ ∃ j, (i, j) ∈ μ ∧ T i j < val :=
begin
  simp_rw ← T.irbc_strip_mem, refl,
end

def ssyt.irbc {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) : ℕ :=
finset.max' _ $ T.irbc_aux.mpr exists_lt

lemma ssyt.irbc_cell_and_lt_val {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) :
(i, T.irbc exists_lt) ∈ μ ∧ T i (T.irbc exists_lt) < val :=
begin
  rw ← T.irbc_strip_mem, apply finset.max'_mem,
end

lemma ssyt.irbc_lt_iff {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) (j : ℕ) :
  T.irbc exists_lt < j ↔ (i, j) ∈ μ → val ≤ T i j :=
begin
  simp_rw [ssyt.irbc, finset.max'_lt_iff, ssyt.irbc_strip_mem],
  rw ← not_iff_not, push_neg,
  split,
  rintro ⟨j', ⟨cell', hj'⟩, hj''⟩,
  exact ⟨μ.nw_of (by refl) hj'' cell',
         lt_of_le_of_lt (T.row_weak' hj'' cell') hj'⟩,
  intro hj, exact ⟨j, hj, by refl⟩,
end

lemma ssyt.le_irbc_iff {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) (j : ℕ) :
  j ≤ T.irbc exists_lt ↔ (i, j) ∈ μ ∧ T i j < val :=
begin
  rw [← not_iff_not], push_neg, rw ssyt.irbc_lt_iff,
end

lemma ssyt.irbc_le_iff {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) (j : ℕ) :
  T.irbc exists_lt ≤ j ↔ ∀ j' > j, (i, j') ∈ μ → val ≤ T i j' :=
begin
  rw [ssyt.irbc, finset.max'_le_iff],
  apply forall_congr, intro a,
  rw [ssyt.irbc_strip_mem, ← not_imp_not], push_neg, refl,
end

lemma ssyt.lt_irbc_iff {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) (j : ℕ) :
  j < T.irbc exists_lt ↔ ∃ j' > j, (i, j') ∈ μ ∧ T i j' < val :=
begin
  rw ← not_iff_not, push_neg, rw ssyt.irbc_le_iff,
end

lemma ssyt.irbc_eq_iff {μ : young_diagram} (T : ssyt μ) {i val : ℕ}
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) (j : ℕ) :
  T.irbc exists_lt = j ↔
  (i, j) ∈ μ ∧ T i j < val ∧ (∀ j' > j, (i, j') ∈ μ → val ≤ T i j') :=
begin
  rw [eq_comm, eq_iff_le_not_lt], push_neg,
  rw [ssyt.le_irbc_iff, ssyt.irbc_le_iff, and_assoc],
end

lemma ssyt.irbc_eq_of_eq_row
  {μ ν : young_diagram} (T : ssyt μ) (T' : ssyt ν) {i val : ℕ}
  (eq_cell : ∀ {j}, (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_row : ∀ {j}, T i j = T' i j)
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val)
  (exists_lt' : ∃ j, (i, j) ∈ ν ∧ T' i j < val := by {
    obtain ⟨j, hj⟩ := exists_lt, rw [eq_cell, eq_row] at hj, exact ⟨j, hj⟩
  }) :
  T.irbc exists_lt = T'.irbc exists_lt' :=
begin
  rw T.irbc_eq_iff,
  -- change first statement
  rw [eq_cell, eq_row],
  -- change second statement
  simp_rw [eq_cell, eq_row],
  rw ← T'.irbc_eq_iff,
end

lemma ssyt.irbc_eq_of_eq_row'
  {μ ν : young_diagram} (T : ssyt μ) (T' : ssyt ν) {i val i' val' : ℕ}
  (eq_cell : ∀ {j}, (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_row : ∀ {j}, T i j = T' i j)
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val)
  (exists_lt' : ∃ j, (i', j) ∈ ν ∧ T' i' j < val')
  (hi : i' = i) (hval : val' = val) :
  T.irbc exists_lt = T'.irbc exists_lt' :=
begin
  rw T.irbc_eq_iff,
  simp_rw [eq_cell, eq_row, ← hi, ← hval],
  rw ← T'.irbc_eq_iff,
end

end inverse_row_bump_column

section inverse_row_bump_step

section irbs_cert

structure ssyt.irbs_cert {μ : young_diagram} (T : ssyt μ) :=
  (i val : ℕ)
  (exists_lt : ∃ j, (i, j) ∈ μ ∧ T i j < val) -- can just use 0!
  (down : ∀ i', i < i' → (i', T.irbc exists_lt) ∈ μ →
    val < T i' (T.irbc exists_lt))

@[reducible]
def ssyt.irbs_cert.j {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) : ℕ :=
  T.irbc h.exists_lt

@[reducible]
def ssyt.irbs_cert.out {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) : ℕ :=
  T h.i h.j

lemma ssyt.irbs_cert.cell {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) :
  (h.i, h.j) ∈ μ := (T.irbc_cell_and_lt_val h.exists_lt).1

lemma ssyt.irbs_cert.out_lt_val {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) :
  h.out < h.val := (T.irbc_cell_and_lt_val h.exists_lt).2

def ssyt.irbs_cert.to_legal {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) :
  T.legal :=
{ i := h.i,
  j := h.j,
  val := h.val,
  cell_left := λ j hj, μ.nw_of (by refl) (le_of_lt hj) h.cell,
  cell_up := λ i hi, μ.nw_of (le_of_lt hi) (by refl) h.cell,
  left := λ j hj, (T.row_weak hj h.cell).trans (le_of_lt h.out_lt_val),
  right := λ j hj cell, (T.irbc_lt_iff h.exists_lt _).mp hj cell,
  up := λ i hi, (T.col_strict hi h.cell).trans h.out_lt_val,
  down := h.down }

lemma ssyt.exists_lt_of_del_inner {μ : young_diagram} (T : ssyt μ)
  (c : μ.inner_corner) (hc : c.i ≠ 0) :
  ∃ j, (c.i.pred, j) ∈ c.del ∧ (T.del c) c.i.pred j < T c.i c.j :=
begin
  use c.j,
  have not_cell : (c.i.pred, c.j) ≠ (c.i, c.j) :=
    λ h, (ne_of_lt (nat.pred_lt hc)) (prod.mk.inj_right c.j h),
  rw [c.mem_del, T.del_entry, if_neg not_cell],
  exact ⟨⟨not_cell, μ.nw_of (nat.pred_le _) (by refl) c.cell⟩,
          T.col_strict (nat.pred_lt hc) c.cell⟩,
end

def ssyt.irbs_cert_of_inner_corner  {μ : young_diagram} (T : ssyt μ)
  (c : μ.inner_corner) (hc : c.i ≠ 0) : (T.del c).irbs_cert :=
{ i := c.i.pred,
  val := T c.i c.j,
  exists_lt := T.exists_lt_of_del_inner c hc,
  down := λ i' hi' cell', begin
    suffices : c.j ≤ (T.del c).irbc (T.exists_lt_of_del_inner c hc),
      have cell := c.del.nw_of (nat.le_of_pred_lt hi') this cell',
      rw c.mem_del at cell, exfalso, exact cell.1 rfl,

    have hi_ne : c.i.pred ≠ c.i := ne_of_lt (nat.pred_lt hc),
    rw [ssyt.le_irbc_iff, c.mem_del, T.del_entry_eq_of_ne_row hi_ne],
    split, split,
    exact λ h, hi_ne (prod.mk.inj_right c.j h),
    exact μ.nw_of (nat.pred_le _) (by refl) c.cell,
    exact T.col_strict (nat.pred_lt hc) c.cell,
  end,
}

def ssyt.irbs_cert.copy {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (eq_cell : ∀ i j (hi : h.i ≤ i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_ge_row : ∀ i j (hi : h.i ≤ i), T i j = T' i j) : T'.irbs_cert :=
{ i := h.i, val := h.val,
  exists_lt := begin
    simp_rw [← eq_cell _ _ (le_refl _), ← eq_ge_row _ _ (le_refl _)],
    exact h.exists_lt,
  end,
  down := λ i' hi', begin
    rw [← eq_cell _ _ (le_of_lt hi'), ← eq_ge_row _ _ (le_of_lt hi')],
    rw ← T.irbc_eq_of_eq_row T',
    exact h.down i' hi',
    exact λ j, eq_cell _ _ (by refl),
    exact λ j, eq_ge_row _ _ (by refl),
  end
}

end irbs_cert

section irbs

def ssyt.irbs_cert.irbs {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert) :
  ssyt μ := h.to_legal.replace h.cell

lemma ssyt.irbs_cert.irbs_entry {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  (i j : ℕ) : h.irbs i j = ite ((i, j) = (h.i, h.j)) h.val (T i j) := rfl

lemma ssyt.irbs_cert.irbs_wt {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  (val : ℕ) :
  h.irbs.wt val + ite (val = T h.i h.j) 1 0 = T.wt val + ite (val = h.val) 1 0 :=
by apply ssyt.wt_replace

lemma ssyt.irbs_cert.irbs_entry_eq_of_ne_row {μ : young_diagram} {T : ssyt μ}
  (h : T.irbs_cert) {i j : ℕ} (hi : i ≠ h.i) : h.irbs i j = T i j :=
begin
  rw [h.irbs_entry, if_neg], rintro ⟨⟩, exact hi rfl
end

lemma ssyt.irbs_cert.next_exists_lt {μ : young_diagram} {T : ssyt μ}
  (h : T.irbs_cert) (hi_pos : h.i ≠ 0) :
  ∃ (j : ℕ), (h.i.pred, j) ∈ μ ∧ (h.irbs) h.i.pred j < h.out :=
begin
  use h.j, split,
  apply μ.nw_of (nat.pred_le _) (le_refl _) h.cell,
  rw h.irbs_entry_eq_of_ne_row (ne_of_lt (nat.pred_lt hi_pos)),
  exact T.col_strict (nat.pred_lt hi_pos) h.cell,
end

lemma ssyt.irbs_cert.le_next_irbc {μ : young_diagram} {T : ssyt μ}
  (h : T.irbs_cert) (hi_pos : h.i ≠ 0) :
  h.j ≤ h.irbs.irbc (h.next_exists_lt hi_pos) :=
begin
  rw ssyt.le_irbc_iff, split, exact μ.nw_of (nat.pred_le _) (by refl) h.cell,
  rw h.irbs_entry_eq_of_ne_row (ne_of_lt _),
  apply T.col_strict _ h.cell,
  all_goals {exact nat.pred_lt hi_pos},
end

@[simps]
def ssyt.irbs_cert.next_cert {μ : young_diagram} {T : ssyt μ} (h : T.irbs_cert)
  (hi_pos : h.i ≠ 0) : h.irbs.irbs_cert :=
{ i := h.i.pred,
  val := h.out,
  exists_lt := begin
    use h.j, split,
    apply μ.nw_of (nat.pred_le _) (le_refl _) h.cell,
    rw h.irbs_entry_eq_of_ne_row (ne_of_lt (nat.pred_lt hi_pos)),
    exact T.col_strict (nat.pred_lt hi_pos) h.cell,
  end,
  down := λ i' hi' cell', begin
    replace hi' := nat.le_of_pred_lt hi',
    apply le_trans _ (h.irbs.col_weak hi' cell'),
    apply lt_of_lt_of_le h.out_lt_val,
    apply le_trans _ (h.irbs.row_weak' (h.le_next_irbc hi_pos) _),
    rw h.irbs_entry, split_ifs; refl,
    exact μ.nw_of hi' (by refl) cell',
  end
}

-- what is the correct "lexicographic" fact here?
-- (the inverse fact to [row_insertion.lean/ssyt.rbs_cert.rbc_lt_rbc] ?)

-- if we inverse-bump a second corner west of the first one, the resulting out-value
-- is ≤ the first one

-- intermediate stage: if we inverse-bump in the same row with a value k' s.t.
-- k' ≤ k, then j' < j and out' ≤ out

lemma ssyt.irbs_cert.irbc_lt_irbc {μ : young_diagram} {T : ssyt μ}
  (h : T.irbs_cert) (h' : h.irbs.irbs_cert)
  (hi : h'.i = h.i) (hval : h'.val ≤ h.val) :
  h'.j < h.j :=
begin
  rw ssyt.irbc_lt_iff, intro _, rwa [hi, h.irbs_entry, if_pos rfl],
end

lemma ssyt.irbs_cert.irbc_out_le_irbc_out {μ : young_diagram} {T : ssyt μ}
  (h : T.irbs_cert) (h' : h.irbs.irbs_cert)
  (hi : h'.i = h.i) (hval : h'.val ≤ h.val) :
  h'.out ≤ h.out :=
begin
  have hj : h'.j < h.j := h.irbc_lt_irbc h' hi hval,
  rw [ssyt.irbs_cert.out, h.irbs_entry, hi, if_neg],
  exact T.row_weak hj h.cell,
  exact λ h, (ne_of_lt hj) (prod.mk.inj_left _ h),
end

end irbs

end inverse_row_bump_step


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.category.Mon.basic
import category_theory.endomorphism

/-!
# Category instances for group, add_group, comm_group, and add_comm_group.

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

We introduce the bundled categories:
* `Group`
* `AddGroup`
* `CommGroup`
* `AddCommGroup`
along with the relevant forgetful functors between them, and to the bundled monoid categories.
-/

universes u v

open category_theory

/-- The category of groups and group morphisms. -/
@[to_additive AddGroup]
def Group : Type (u+1) := bundled group

/-- The category of additive groups and group morphisms -/
add_decl_doc AddGroup

namespace Group

@[to_additive]
instance : bundled_hom.parent_projection group.to_monoid := ⟨⟩

attribute [derive [large_category, concrete_category]] Group
attribute [to_additive] Group.large_category Group.concrete_category

@[to_additive] instance : has_coe_to_sort Group Type* := bundled.has_coe_to_sort

/-- Construct a bundled `Group` from the underlying type and typeclass. -/
@[to_additive] def of (X : Type u) [group X] : Group := bundled.of X

/-- Construct a bundled `AddGroup` from the underlying type and typeclass. -/
add_decl_doc AddGroup.of

/-- Typecheck a `monoid_hom` as a morphism in `Group`. -/
@[to_additive] def of_hom {X Y : Type u} [group X] [group Y] (f : X →* Y) : of X ⟶ of Y := f

/-- Typecheck a `add_monoid_hom` as a morphism in `AddGroup`. -/
add_decl_doc AddGroup.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type*} [group X] [group Y] (f : X →* Y) (x : X) :
  of_hom f x = f x := rfl

@[to_additive]
instance (G : Group) : group G := G.str

@[simp, to_additive] lemma coe_of (R : Type u) [group R] : (Group.of R : Type u) = R := rfl

@[to_additive]
instance : inhabited Group := ⟨Group.of punit⟩

@[to_additive]
instance of_unique (G : Type*) [group G] [i : unique G] : unique (Group.of G) := i

@[simp, to_additive]
lemma one_apply (G H : Group) (g : G) : (1 : G ⟶ H) g = 1 := rfl

@[ext, to_additive]

@[to_additive has_forget_to_AddMon]
instance has_forget_to_Mon : has_forget₂ Group Mon := bundled_hom.forget₂ _ _

@[to_additive] instance : has_coe Group.{u} Mon.{u} :=
{ coe := (forget₂ Group Mon).obj, }

end Group

/-- The category of commutative groups and group morphisms. -/
@[to_additive AddCommGroup]
def CommGroup : Type (u+1) := bundled comm_group

/-- The category of additive commutative groups and group morphisms. -/
add_decl_doc AddCommGroup

/-- `Ab` is an abbreviation for `AddCommGroup`, for the sake of mathematicians' sanity. -/
abbreviation Ab := AddCommGroup

namespace CommGroup

@[to_additive]
instance : bundled_hom.parent_projection comm_group.to_group := ⟨⟩

attribute [derive [large_category, concrete_category]] CommGroup
attribute [to_additive] CommGroup.large_category CommGroup.concrete_category

@[to_additive] instance : has_coe_to_sort CommGroup Type* := bundled.has_coe_to_sort

/-- Construct a bundled `CommGroup` from the underlying type and typeclass. -/
@[to_additive] def of (G : Type u) [comm_group G] : CommGroup := bundled.of G

/-- Construct a bundled `AddCommGroup` from the underlying type and typeclass. -/
add_decl_doc AddCommGroup.of

/-- Typecheck a `monoid_hom` as a morphism in `CommGroup`. -/
@[to_additive] def of_hom {X Y : Type u} [comm_group X] [comm_group Y] (f : X →* Y) :
  of X ⟶ of Y := f

/-- Typecheck a `add_monoid_hom` as a morphism in `AddCommGroup`. -/
add_decl_doc AddCommGroup.of_hom

@[simp, to_additive] lemma of_hom_apply {X Y : Type*} [comm_group X] [comm_group Y] (f : X →* Y)
  (x : X) : of_hom f x = f x := rfl

@[to_additive]
instance comm_group_instance (G : CommGroup) : comm_group G := G.str

@[simp, to_additive] lemma coe_of (R : Type u) [comm_group R] : (CommGroup.of R : Type u) = R := rfl

@[to_additive]
instance : inhabited CommGroup := ⟨CommGroup.of punit⟩

@[to_additive]
instance of_unique (G : Type*) [comm_group G] [i : unique G] : unique (CommGroup.of G) := i

@[simp, to_additive]
lemma one_apply (G H : CommGroup) (g : G) : (1 : G ⟶ H) g = 1 := rfl

@[ext, to_additive]
lemma ext (G H : CommGroup) (f₁ f₂ : G ⟶ H) (w : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
by { ext1, apply w }

@[to_additive has_forget_to_AddGroup]
instance has_forget_to_Group : has_forget₂ CommGroup Group := bundled_hom.forget₂ _ _

@[to_additive] instance : has_coe CommGroup.{u} Group.{u} :=
{ coe := (forget₂ CommGroup Group).obj, }

@[to_additive has_forget_to_AddCommMon]
instance has_forget_to_CommMon : has_forget₂ CommGroup CommMon :=
induced_category.has_forget₂ (λ G : CommGroup, CommMon.of G)

@[to_additive] instance : has_coe CommGroup.{u} CommMon.{u} :=
{ coe := (forget₂ CommGroup CommMon).obj, }

end CommGroup

-- This example verifies an improvement possible in Lean 3.8.
-- Before that, to have `monoid_hom.map_map` usable by `simp` here,
-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.
-- Now, it just works.
@[to_additive]
example {R S : CommGroup} (i : R ⟶ S) (r : R) (h : r = 1) : i r = 1 :=
by simp [h]

namespace AddCommGroup

/-- Any element of an abelian group gives a unique morphism from `ℤ` sending
`1` to that element. -/
-- Note that because `ℤ : Type 0`, this forces `G : AddCommGroup.{0}`,
-- so we write this explicitly to be clear.
-- TODO generalize this, requiring a `ulift_instances.lean` file
def as_hom {G : AddCommGroup.{0}} (g : G) : (AddCommGroup.of ℤ) ⟶ G :=
zmultiples_hom G g

@[simp]
lemma as_hom_apply {G : AddCommGroup.{0}} (g : G) (i : ℤ) : (as_hom g) i = i • g := rfl

lemma as_hom_injective {G : AddCommGroup.{0}} : function.injective (@as_hom G) :=
λ h k w, by convert congr_arg (λ k : (AddCommGroup.of ℤ) ⟶ G, (k : ℤ → G) (1 : ℤ)) w; simp

@[ext]
lemma int_hom_ext
  {G : AddCommGroup.{0}} (f g : (AddCommGroup.of ℤ) ⟶ G) (w : f (1 : ℤ) = g (1 : ℤ)) : f = g :=
add_monoid_hom.ext_int w

-- TODO: this argument should be generalised to the situation where
-- the forgetful functor is representable.
lemma injective_of_mono {G H : AddCommGroup.{0}} (f : G ⟶ H) [mono f] : function.injective f :=
λ g₁ g₂ h,
begin
  have t0 : as_hom g₁ ≫ f = as_hom g₂ ≫ f :=
  begin
    ext,
    simpa [as_hom_apply] using h,
  end,
  have t1 : as_hom g₁ = as_hom g₂ := (cancel_mono _).1 t0,
  apply as_hom_injective t1,
end

end AddCommGroup

/-- Build an isomorphism in the category `Group` from a `mul_equiv` between `group`s. -/
@[to_additive add_equiv.to_AddGroup_iso, simps]
def mul_equiv.to_Group_iso {X Y : Group} (e : X ≃* Y) : X ≅ Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

/-- Build an isomorphism in the category `AddGroup` from an `add_equiv` between `add_group`s. -/
add_decl_doc add_equiv.to_AddGroup_iso

/-- Build an isomorphism in the category `CommGroup` from a `mul_equiv` between `comm_group`s. -/
@[to_additive add_equiv.to_AddCommGroup_iso, simps]
def mul_equiv.to_CommGroup_iso {X Y : CommGroup} (e : X ≃* Y) : X ≅ Y :=
{ hom := e.to_monoid_hom,
  inv := e.symm.to_monoid_hom }

/-- Build an isomorphism in the category `AddCommGroup` from a `add_equiv` between
`add_comm_group`s. -/
add_decl_doc add_equiv.to_AddCommGroup_iso

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Group`. -/
@[to_additive AddGroup_iso_to_add_equiv "Build an `add_equiv` from an isomorphism in the category
`AddGroup`.", simps]
def Group_iso_to_mul_equiv {X Y : Group} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

/-- Build a `mul_equiv` from an isomorphism in the category `CommGroup`. -/
@[to_additive AddCommGroup_iso_to_add_equiv "Build an `add_equiv` from an isomorphism
in the category `AddCommGroup`.", simps]
def CommGroup_iso_to_mul_equiv {X Y : CommGroup} (i : X ≅ Y) : X ≃* Y :=
i.hom.to_mul_equiv i.inv i.hom_inv_id i.inv_hom_id

end category_theory.iso

/-- multiplicative equivalences between `group`s are the same as (isomorphic to) isomorphisms
in `Group` -/
@[to_additive add_equiv_iso_AddGroup_iso "additive equivalences between `add_group`s are the same
as (isomorphic to) isomorphisms in `AddGroup`"]
def mul_equiv_iso_Group_iso {X Y : Group.{u}} : (X ≃* Y) ≅ (X ≅ Y) :=
{ hom := λ e, e.to_Group_iso,
  inv := λ i, i.Group_iso_to_mul_equiv, }

/-- multiplicative equivalences between `comm_group`s are the same as (isomorphic to) isomorphisms
in `CommGroup` -/
@[to_additive add_equiv_iso_AddCommGroup_iso "additive equivalences between `add_comm_group`s are
the same as (isomorphic to) isomorphisms in `AddCommGroup`"]
def mul_equiv_iso_CommGroup_iso {X Y : CommGroup.{u}} : X ≃* Y ≅ (X ≅ Y) :=
{ hom := λ e, e.to_CommGroup_iso,
  inv := λ i, i.CommGroup_iso_to_mul_equiv, }

namespace category_theory.Aut

/-- The (bundled) group of automorphisms of a type is isomorphic to the (bundled) group
of permutations. -/
def iso_perm {α : Type u} : Group.of (Aut α) ≅ Group.of (equiv.perm α) :=
{ hom := ⟨λ g, g.to_equiv, (by tidy), (by tidy)⟩,
  inv := ⟨λ g, g.to_iso, (by tidy), (by tidy)⟩ }

/-- The (unbundled) group of automorphisms of a type is `mul_equiv` to the (unbundled) group
of permutations. -/
def mul_equiv_perm {α : Type u} : Aut α ≃* equiv.perm α :=
iso_perm.Group_iso_to_mul_equiv

end category_theory.Aut

@[to_additive]
instance Group.forget_reflects_isos : reflects_isomorphisms (forget Group.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Group).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Group_iso).1⟩,
  end }

@[to_additive]
instance CommGroup.forget_reflects_isos : reflects_isomorphisms (forget CommGroup.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget CommGroup).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_CommGroup_iso).1⟩,
  end }


import metalogic.mm0.mm0
import metalogic.mm0.fol

/-
noncomputable
def mm0.formula.to_fol_formula
  (M : mm0.meta_var_name → fol.formula) :
  mm0.env → mm0.formula → fol.formula
| E (mm0.formula.meta_var_ X) := M X
| E (mm0.formula.false_) := fol.formula.false_
| E (mm0.formula.pred_ name args) := fol.formula.pred_ name args
| E (mm0.formula.not_ φ) :=
    fol.formula.not_ (mm0.formula.to_fol_formula E φ)
| E (mm0.formula.imp_ φ ψ) :=
    fol.formula.imp_ (mm0.formula.to_fol_formula E φ) (mm0.formula.to_fol_formula E ψ)
| E (mm0.formula.eq_ x y) := fol.formula.eq_ x y
| E (mm0.formula.forall_ x φ) :=
    fol.formula.forall_ x (mm0.formula.to_fol_formula E φ)
| [] (mm0.formula.def_ _ _) := fol.formula.false_
| (d :: E) (mm0.formula.def_ name args) :=
  by classical; exact
  if h : name = d.name ∧ ∃ (σ : mm0.instantiation), args = d.args.map σ.1
  then
    let σ := classical.some h.right in
    mm0.formula.to_fol_formula E (d.q.subst σ mm0.formula.meta_var_)
  else mm0.formula.to_fol_formula E (mm0.formula.def_ name args)
-/

noncomputable
def mm0.formula.to_fol_formula'
  (M : mm0.meta_var_name → fol.formula)
  (mm0_formula_to_fol_formula : mm0.formula → fol.formula)
  (d : option mm0.definition_) :
  mm0.formula → fol.formula
| (mm0.formula.meta_var_ X) := M X
| (mm0.formula.false_) := fol.formula.false_
| (mm0.formula.pred_ name args) := fol.formula.pred_ name args
| (mm0.formula.not_ φ) := fol.formula.not_ φ.to_fol_formula'
| (mm0.formula.imp_ φ ψ) := fol.formula.imp_ φ.to_fol_formula' ψ.to_fol_formula'
| (mm0.formula.eq_ x y) := fol.formula.eq_ x y
| (mm0.formula.forall_ x φ) := fol.formula.forall_ x φ.to_fol_formula'
| (mm0.formula.def_ name args) :=
    option.elim
      fol.formula.false_
      (
        fun (d : mm0.definition_),
          by classical; exact
          if h : name = d.name ∧ ∃ (σ : mm0.instantiation), args = d.args.map σ.1
          then
            let σ := classical.some h.right in
            mm0_formula_to_fol_formula (d.q.subst σ mm0.formula.meta_var_)
          else
            mm0_formula_to_fol_formula (mm0.formula.def_ name args)
      )
      d

noncomputable
def mm0.formula.to_fol_formula
  (M : mm0.meta_var_name → fol.formula) :
  mm0.env → mm0.formula → fol.formula
| [] := mm0.formula.to_fol_formula' M (fun _, fol.formula.false_) option.none
| (d :: E) := mm0.formula.to_fol_formula' M (mm0.formula.to_fol_formula E) (option.some d)

@[simp]
lemma meta_var_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (X : mm0.meta_var_name) :
  mm0.formula.to_fol_formula M E (mm0.formula.meta_var_ X) =
    M X := by {cases E; refl}

@[simp]
lemma false_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env) :
  mm0.formula.to_fol_formula M E mm0.formula.false_ =
    fol.formula.false_ := by {cases E; refl}

@[simp]
lemma pred_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (name : mm0.pred_name)
  (args : list mm0.var_name) :
  mm0.formula.to_fol_formula M E (mm0.formula.pred_ name args) =
    fol.formula.pred_ name args := by {cases E; refl}

@[simp]
lemma not_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (φ : mm0.formula) :
  mm0.formula.to_fol_formula M E (mm0.formula.not_ φ) =
    fol.formula.not_ (mm0.formula.to_fol_formula M E φ) :=
begin
  cases E,
  case list.nil
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
  case list.cons : E_hd E_tl
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
end

@[simp]
lemma imp_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (φ ψ : mm0.formula) :
  mm0.formula.to_fol_formula M E (mm0.formula.imp_ φ ψ) =
    fol.formula.imp_ (mm0.formula.to_fol_formula M E φ) (mm0.formula.to_fol_formula M E ψ) :=
begin
  cases E,
  case list.nil
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
  case list.cons : E_hd E_tl
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
end

@[simp]
lemma eq_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (x y : mm0.var_name) :
  mm0.formula.to_fol_formula M E (mm0.formula.eq_ x y) =
    fol.formula.eq_ x y := by {cases E; refl}

@[simp]
lemma forall_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (x : mm0.var_name)
  (φ : mm0.formula) :
  mm0.formula.to_fol_formula M E (mm0.formula.forall_ x φ) =
    fol.formula.forall_ x (mm0.formula.to_fol_formula M E φ) :=
begin
  cases E,
  case list.nil
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
  case list.cons : E_hd E_tl
  {
    unfold mm0.formula.to_fol_formula,
    unfold mm0.formula.to_fol_formula',
  },
end

@[simp]
lemma nil_def_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (name : mm0.pred_name)
  (args : list mm0.var_name) :
  mm0.formula.to_fol_formula M [] (mm0.formula.def_ name args) =
    fol.formula.false_ := by {refl}

@[simp]
lemma not_nil_def_to_fol_formula
  (M : mm0.meta_var_name → fol.formula)
  (d : mm0.definition_)
  (E : mm0.env)
  (name : mm0.pred_name)
  (args : list mm0.var_name) :
  mm0.formula.to_fol_formula M (d :: E) (mm0.formula.def_ name args) =
  by classical; exact
  if h : name = d.name ∧ ∃ (σ : mm0.instantiation), args = d.args.map σ.1
  then
    let σ := classical.some h.right in
    mm0.formula.to_fol_formula M E (d.q.subst σ mm0.formula.meta_var_)
  else mm0.formula.to_fol_formula M E (mm0.formula.def_ name args) :=
begin
  unfold mm0.formula.to_fol_formula,
  unfold mm0.formula.to_fol_formula',
  simp only [option.elim],
end

lemma not_nil_def_to_fol_formula'
  (M : mm0.meta_var_name → fol.formula)
  (d : mm0.definition_)
  (E : mm0.env)
  (name : mm0.def_name)
  (args : list mm0.var_name)
  (h1 : name = d.name ∧ ∃ (σ : mm0.instantiation), args = d.args.map σ.1) :
  ∃ (σ : mm0.instantiation), args = d.args.map σ.1 ∧
  mm0.formula.to_fol_formula M (d :: E) (mm0.formula.def_ name args) =
    mm0.formula.to_fol_formula M E (d.q.subst σ mm0.formula.meta_var_) :=
begin
  let σ := classical.some h1.right,
  have h2 := classical.some_spec h1.right,
  simp only [not_nil_def_to_fol_formula, dif_pos h1],
  exact ⟨σ, h2, rfl⟩,
end

lemma to_fol_formula_no_def
  (name : mm0.def_name)
  (args : list mm0.var_name)
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (h1 : ∀ (d : mm0.definition_), d ∈ E →
    name = d.name →
      ∀ (σ : mm0.instantiation), ¬ args = list.map σ.val d.args) :
  mm0.formula.to_fol_formula M E (mm0.formula.def_ name args)
    = fol.formula.false_ :=
begin
  induction E,
  case list.nil
  {
    simp only [nil_def_to_fol_formula],
  },
  case list.cons : E_hd E_tl E_ih
  {
    simp only [not_nil_def_to_fol_formula],
    split_ifs,
    {
      cases h,
      apply exists.elim h_right,
      intros σ h_right_1,
      dsimp,

      exfalso,
      apply h1 E_hd _ h_left σ h_right_1,
      simp only [list.mem_cons_iff, eq_self_iff_true, true_or],
    },
    {
      apply E_ih,
      intros d a1 a2 contra,
      apply h1,
      {
        simp only [list.mem_cons_iff],
        apply or.intro_right,
        exact a1,
      },
      {
        exact a2,
      }
    }
  },
end

lemma to_fol_formula_env_ext
  (M : mm0.meta_var_name → fol.formula)
  (d : mm0.definition_)
  (E : mm0.env)
  (name : mm0.def_name)
  (args : list mm0.var_name)
  (h1 : ¬((name = d.name) ∧ (∃ (σ : mm0.instantiation), (args = list.map σ.val d.args)))) :
  (mm0.formula.to_fol_formula M (d :: E) (mm0.formula.def_ name args)) =
    (mm0.formula.to_fol_formula M E (mm0.formula.def_ name args)) :=
begin
  simp only [not_nil_def_to_fol_formula, dite_eq_right_iff],
  intros contra,
  contradiction,
end

lemma to_fol_formula_env_ext'
  (M : mm0.meta_var_name → fol.formula)
  (E E' : mm0.env)
  (φ : mm0.formula)
  (h1 : ∃ (E1 : mm0.env), E' = E1 ++ E)
  (h2 : φ.is_meta_var_or_all_def_in_env E)
  (h3 : E'.well_formed) :
  (mm0.formula.to_fol_formula M E φ) =
    (mm0.formula.to_fol_formula M E' φ) :=
begin
  induction E' generalizing φ,
  case list.nil : φ h2
  {
    simp only [list.nil_eq_append_iff, exists_eq_left] at h1,
    rewrite h1,
  },
  case list.cons : E'_hd E'_tl E'_ih φ h2
  {
    induction φ generalizing E'_tl,
    case mm0.formula.meta_var_ : X
    {
      simp only [meta_var_to_fol_formula],
    },
    case mm0.formula.false_
    {
      simp only [false_to_fol_formula],
    },
    case mm0.formula.pred_ : name args
    {
      simp only [pred_to_fol_formula, eq_self_iff_true, and_self],
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.formula.is_meta_var_or_all_def_in_env at h2,

      simp only [not_to_fol_formula],
      apply φ_ih h2,
      {
        intros a1 a2 φ' a3,
        exact E'_ih a1 a2 φ' a3,
      },
      {
        exact h1,
      },
      {
        exact h3,
      }
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.formula.is_meta_var_or_all_def_in_env at h2,
      cases h2,

      simp only [imp_to_fol_formula],
      split,
      {
        apply φ_ih h2_left,
        {
          intros a1 a2 φ' a3,
          exact E'_ih a1 a2 φ' a3,
        },
        {
          exact h1,
        },
        {
          exact h3,
        }
      },
      {
        apply ψ_ih h2_right,
        {
          intros a1 a2 ψ' a3,
          exact E'_ih a1 a2 ψ' a3,
        },
        {
          exact h1,
        },
        {
          exact h3,
        }
      }
    },
    case mm0.formula.eq_ : x y
    {
      simp only [eq_to_fol_formula, eq_self_iff_true, and_self],
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.formula.is_meta_var_or_all_def_in_env at h2,

      simp only [forall_to_fol_formula, eq_self_iff_true, true_and],
      exact φ_ih h2 E'_tl E'_ih h1 h3,
    },
    case mm0.formula.def_ : name args
    {
      apply exists.elim h1,
      intros E1 h1_1,
      cases E1,
      {
        simp only [list.nil_append] at h1_1,
        rewrite <- h1_1,
      },
      {
        simp only [list.cons_append] at h1_1,
        have s1 : ∃ (E1 : mm0.env), (E'_tl = (E1 ++ E)),
        apply exists.intro E1_tl,
        injection h1_1,

        unfold mm0.formula.is_meta_var_or_all_def_in_env at h2,
        apply exists.elim h2,
        intros d h2_1,
        cases h2_1,
        cases h2_1_right,
        clear h2,

        have s2 : d ∈ E'_tl,
        injection h1_1,
        rewrite h_2,
        simp only [list.mem_append],
        apply or.intro_right,
        exact h2_1_left,

        unfold mm0.env.well_formed at h3,
        cases h3,
        cases h3_right,

        specialize h3_left d s2,

        have s3 : ¬ ((name = E'_hd.name) ∧ (∃ (a : mm0.instantiation), (args = list.map (a.val) E'_hd.args))),
        push_neg,
        intros a1 σ contra,
        apply h3_left,
        rewrite <- h2_1_right_left,
        rewrite a1,
        rewrite <- h2_1_right_right,
        rewrite contra,
        symmetry,
        apply list.length_map,

        simp only [subtype.val_eq_coe, not_nil_def_to_fol_formula],
        rewrite dif_neg,
        rewrite E'_ih s1 h3_right_right,
        {
          push_neg at s3,
          unfold mm0.formula.is_meta_var_or_all_def_in_env,
          apply exists.intro d,
          split,
          exact h2_1_left,
          split,
          exact h2_1_right_left,
          exact h2_1_right_right,
        },
        {
          exact s3,
        }
      }
    },
  },
end

lemma to_fol_formula_no_meta_var
  (M M' : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (φ : mm0.formula)
  (h1 : φ.meta_var_set = ∅) :
  mm0.formula.to_fol_formula M E φ = mm0.formula.to_fol_formula M' E φ :=
begin
  induction E generalizing φ,
  case list.nil : φ h1
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [finset.singleton_ne_empty] at h1,
      contradiction,
    },
    case mm0.formula.false_
    {
      refl,
    },
    case mm0.formula.pred_ : name args
    {
      refl,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [not_to_fol_formula],
      exact φ_ih h1,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [finset.union_eq_empty_iff] at h1,
      cases h1,

      simp only [imp_to_fol_formula],
      split,
      {
        exact φ_ih h1_left,
      },
      {
        exact ψ_ih h1_right,
      }
    },
    case mm0.formula.eq_ : x y
    {
      refl,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.formula.meta_var_set at h1,

      simp only [forall_to_fol_formula, eq_self_iff_true, true_and],
      exact φ_ih h1,
    },
    case mm0.formula.def_ : name args
    {
      refl,
    },
  },
  case list.cons : E_hd E_tl E_ih φ h1
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [finset.singleton_ne_empty] at h1,
      contradiction,
    },
    case mm0.formula.false_
    {
      refl,
    },
    case mm0.formula.pred_ : name args
    {
      refl,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [not_to_fol_formula],
      exact φ_ih h1,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.formula.meta_var_set at h1,
      simp only [finset.union_eq_empty_iff] at h1,
      cases h1,

      simp only [imp_to_fol_formula],
      split,
      {
        exact φ_ih h1_left,
      },
      {
        exact ψ_ih h1_right,
      }
    },
    case mm0.formula.eq_ : x y
    {
      refl,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.formula.meta_var_set at h1,

      simp only [forall_to_fol_formula, eq_self_iff_true, true_and],
      exact φ_ih h1,
    },
    case mm0.formula.def_ : name args
    {
      simp only [not_nil_def_to_fol_formula],
      split_ifs,
      {
        apply E_ih,
        apply mm0.subst_no_meta_var,
        apply mm0.no_meta_var_imp_meta_var_set_is_empty E_hd.q E_hd.args E_hd.nf,
      },
      {
        apply E_ih _ h1,
      }
    },
  },
end

def fol.formula.to_mm0_formula : fol.formula → mm0.formula
| (fol.formula.false_) := mm0.formula.false_
| (fol.formula.pred_ name args) := mm0.formula.pred_ name args
| (fol.formula.not_ φ) := mm0.formula.not_ φ.to_mm0_formula
| (fol.formula.imp_ φ ψ) := mm0.formula.imp_ φ.to_mm0_formula ψ.to_mm0_formula
| (fol.formula.eq_ x y) := mm0.formula.eq_ x y
| (fol.formula.forall_ x φ) := mm0.formula.forall_ x φ.to_mm0_formula

example
  (φ : fol.formula)
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env):
  mm0.formula.to_fol_formula M E (fol.formula.to_mm0_formula φ) = φ :=
begin
  induction φ,
  case fol.formula.false_
  {
    unfold fol.formula.to_mm0_formula,
    simp only [false_to_fol_formula],
  },
  case fol.formula.pred_ : name args
  {
    unfold fol.formula.to_mm0_formula,
    simp only [pred_to_fol_formula, eq_self_iff_true, and_self],
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold fol.formula.to_mm0_formula,
    simp only [not_to_fol_formula],
    exact φ_ih,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold fol.formula.to_mm0_formula,
    simp only [imp_to_fol_formula],
    split,
    {
      exact φ_ih,
    },
    {
      exact ψ_ih,
    }
  },
  case fol.formula.eq_ : x y
  {
    unfold fol.formula.to_mm0_formula,
    simp only [eq_to_fol_formula, eq_self_iff_true, and_self],
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold fol.formula.to_mm0_formula,
    simp only [forall_to_fol_formula, eq_self_iff_true, true_and],
    exact φ_ih,
  },
end

lemma fol_not_free_imp_mm0_not_free
  (Γ : list (mm0.var_name × mm0.meta_var_name))
  (v : fol.var_name)
  (φ : fol.formula)
  (h1 : fol.not_free v φ) :
  mm0.not_free Γ v (fol.formula.to_mm0_formula φ) :=
begin
  induction φ,
  case fol.formula.false_
  {
    unfold fol.formula.to_mm0_formula,
  },
  case fol.formula.pred_ : name args
  {
    unfold fol.formula.to_mm0_formula,
    exact h1,
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold fol.not_free at h1,

    unfold fol.formula.to_mm0_formula,
    exact φ_ih h1,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold fol.not_free at h1,
    cases h1,

    unfold fol.formula.to_mm0_formula,
    unfold mm0.not_free,
    split,
    {
      exact φ_ih h1_left,
    },
    {
      exact ψ_ih h1_right,
    }
  },
  case fol.formula.eq_ : x y
  {
    unfold fol.not_free at h1,
    cases h1,

    unfold fol.formula.to_mm0_formula,
    unfold mm0.not_free,
    split,
    {
      exact h1_left,
    },
    {
      exact h1_right,
    }
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold fol.not_free at h1,

    unfold fol.formula.to_mm0_formula,
    unfold mm0.not_free,
    cases h1,
    {
      apply or.intro_left,
      exact h1,
    },
    {
      apply or.intro_right,
      exact φ_ih h1,
    }
  },
end

lemma mm0_not_free_imp_fol_not_free
  (M : mm0.meta_var_name → fol.formula)
  (Γ : list (mm0.var_name × mm0.meta_var_name))
  (E : mm0.env)
  (v : mm0.var_name)
  (φ : mm0.formula)
  (h1 : mm0.not_free Γ v φ)
  (h2 : ∀ (x : mm0.var_name) (X : mm0.meta_var_name),
    (x, X) ∈ Γ → fol.not_free x (M X)) :
  fol.not_free v (mm0.formula.to_fol_formula M E φ) :=
begin
  induction E generalizing φ,
  case list.nil : φ h1
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      unfold mm0.not_free at h1,
      simp only [meta_var_to_fol_formula],
      exact h2 v X h1,
    },
    case mm0.formula.false_
    {
      simp only [false_to_fol_formula],
    },
    case mm0.formula.pred_ : name args
    {
      simp only [pred_to_fol_formula],
      exact h1,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.not_free at h1,
      simp only [not_to_fol_formula],
      unfold fol.not_free,
      exact φ_ih h1,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.not_free at h1,
      cases h1,
      simp only [imp_to_fol_formula],
      unfold fol.not_free,
      split,
      {
        exact φ_ih h1_left,
      },
      {
        exact ψ_ih h1_right,
      }
    },
    case mm0.formula.eq_ : x y
    {
      unfold mm0.not_free at h1,
      simp only [eq_to_fol_formula],
      unfold fol.not_free,
      exact h1,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.not_free at h1,
      simp only [forall_to_fol_formula],
      unfold fol.not_free,
      cases h1,
      {
        apply or.intro_left,
        exact h1,
      },
      {
        apply or.intro_right,
        exact φ_ih h1,
      }
    },
    case mm0.formula.def_ : name args
    {
      simp only [nil_def_to_fol_formula],
    },
  },
  case list.cons : E_hd E_tl E_ih φ h1
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      unfold mm0.not_free at h1,
      simp only [meta_var_to_fol_formula],
      exact h2 v X h1,
    },
    case mm0.formula.false_
    {
      simp only [false_to_fol_formula],
    },
    case mm0.formula.pred_ : name args
    {
      simp only [pred_to_fol_formula],
      exact h1,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.not_free at h1,
      simp only [not_to_fol_formula],
      unfold fol.not_free,
      exact φ_ih h1,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.not_free at h1,
      cases h1,
      simp only [imp_to_fol_formula],
      unfold fol.not_free,
      split,
      {
        exact φ_ih h1_left,
      },
      {
        exact ψ_ih h1_right,
      }
    },
    case mm0.formula.eq_ : x y
    {
      unfold mm0.not_free at h1,
      simp only [eq_to_fol_formula],
      unfold fol.not_free,
      exact h1,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.not_free at h1,
      simp only [forall_to_fol_formula],
      unfold fol.not_free,
      cases h1,
      {
        apply or.intro_left,
        exact h1,
      },
      {
        apply or.intro_right,
        exact φ_ih h1,
      }
    },
    case mm0.formula.def_ : name args
    {
      simp only [not_nil_def_to_fol_formula],
      split_ifs,
      {
        unfold mm0.not_free at h1,

        cases h,

        apply E_ih,
        apply mm0.all_free_in_list_and_not_in_list_imp_not_free _ (list.map (classical.some h_right).val E_hd.args),
        apply mm0.no_meta_var_and_all_free_in_list_subst,
        exact E_hd.nf,
        rewrite <- classical.some_spec h_right,
        exact h1,
      },
      {
        apply E_ih,
        exact h1,
      }
    },
  },
end

lemma fol_is_proof_forall
  (φ : mm0.formula)
  (x y : fol.var_name)
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (σ σ' : mm0.instantiation) :
  fol.is_proof
  ((fol.formula.forall_ x (mm0.formula.to_fol_formula M E (mm0.formula.subst σ mm0.formula.meta_var_ φ))).imp_
  (fol.formula.forall_ y (mm0.formula.to_fol_formula M E (mm0.formula.subst σ' mm0.formula.meta_var_ φ)))) :=
begin
  sorry,
end

lemma proof_eqv_to_fol_formula_subst
  (φ : mm0.formula)
  (l : list mm0.var_name)
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (σ σ' : mm0.instantiation)
  (h1 : φ.no_meta_var_and_all_free_in_list l)
  (h2 : ∀ (x : mm0.var_name), x ∈ l → σ.val x = σ'.val x) :
  fol.proof_eqv
  (mm0.formula.to_fol_formula M E (mm0.formula.subst σ mm0.formula.meta_var_ φ))
  (mm0.formula.to_fol_formula M E (mm0.formula.subst σ' mm0.formula.meta_var_ φ)) :=
begin
  induction φ generalizing l,
  case mm0.formula.meta_var_ : X l h1 h2
  {
    apply fol.proof_eqv_refl,
    unfold mm0.formula.subst,
  },
  case mm0.formula.false_ : l h1 h2
  {
    apply fol.proof_eqv_refl,
    unfold mm0.formula.subst,
  },
  case mm0.formula.pred_ : name args l h1 h2
  {
    apply fol.proof_eqv_refl,

    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,

    unfold mm0.formula.subst,
    rewrite list.map_congr,
    intros x a1,
    apply h2 x,
    exact h1 a1,
  },
  case mm0.formula.not_ : φ φ_ih l h1 h2
  {
    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,

    unfold mm0.formula.subst,
    simp only [not_to_fol_formula],

    apply fol.proof_eqv_compat_not,
    exact φ_ih l h1 h2,
  },
  case mm0.formula.imp_ : φ ψ φ_ih ψ_ih l h1 h2
  {
    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,
    cases h1,

    unfold mm0.formula.subst,
    simp only [imp_to_fol_formula],
    apply fol.proof_eqv_compat_imp,
    {
      exact φ_ih l h1_left h2,
    },
    {
      exact ψ_ih l h1_right h2,
    }
  },
  case mm0.formula.eq_ : x y l h1 h2
  {
    apply fol.proof_eqv_refl,
    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,
    cases h1,

    unfold mm0.formula.subst,
    congr' 1,
    simp only [eq_to_fol_formula],
    split,
    {
      exact h2 x h1_left,
    },
    {
      exact h2 y h1_right,
    }
  },
  case mm0.formula.forall_ : x φ φ_ih l h1 h2
  {
    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,

    unfold mm0.formula.subst,
    simp only [forall_to_fol_formula],
    unfold fol.proof_eqv,
    split,
    {
      apply fol_is_proof_forall,
    },
    {
      apply fol_is_proof_forall,
    },
  },
  case mm0.formula.def_ : name args l h1 h2
  {
    apply fol.proof_eqv_refl,

    unfold mm0.formula.no_meta_var_and_all_free_in_list at h1,

    unfold mm0.formula.subst,
    rewrite list.map_congr,
    intros x a1,
    apply h2 x,
    exact h1 a1,
  },
end

lemma proof_eqv_subst_to_fol_formula_subst
  (φ : mm0.formula)
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (σ σ_inv : mm0.instantiation)
  (τ : mm0.meta_instantiation)
  (h_inv_left : σ.val ∘ σ_inv.val = id)
  (h_inv_right : σ_inv.val ∘ σ.val = id) :
  fol.proof_eqv
    (mm0.formula.to_fol_formula M E (mm0.formula.subst σ τ φ))
    (fol.formula.subst σ (mm0.formula.to_fol_formula (fol.formula.subst σ_inv ∘ (mm0.formula.to_fol_formula M E ∘ τ)) E φ)) :=
begin
  induction E generalizing φ,
  case list.nil : φ
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [meta_var_to_fol_formula, function.comp_app],
      rewrite fol.subst_inv _ σ_inv σ h_inv_right h_inv_left,
    },
    case mm0.formula.false_
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [false_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.pred_ : name args
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [pred_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.formula.subst,
      simp only [not_to_fol_formula],
      apply fol.proof_eqv_compat_not,
      exact φ_ih,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.formula.subst,
      simp only [imp_to_fol_formula],
      apply fol.proof_eqv_compat_imp,
      {
        exact φ_ih,
      },
      {
        exact ψ_ih,
      }
    },
    case mm0.formula.eq_ : x y
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [eq_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.formula.subst,
      simp only [forall_to_fol_formula],
      apply fol.proof_eqv_compat_forall,
      {
        refl,
      },
      {
        exact φ_ih,
      }
    },
    case mm0.formula.def_ : name args
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [nil_def_to_fol_formula],
      unfold fol.formula.subst,
    },
  },
  case list.cons : E_hd E_tl E_ih φ
  {
    induction φ,
    case mm0.formula.meta_var_ : X
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [meta_var_to_fol_formula, function.comp_app],
      rewrite fol.subst_inv _ σ_inv σ h_inv_right h_inv_left,
    },
    case mm0.formula.false_
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [false_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.pred_ : name args
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [pred_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.not_ : φ φ_ih
    {
      unfold mm0.formula.subst,
      simp only [not_to_fol_formula],
      apply fol.proof_eqv_compat_not,
      exact φ_ih,
    },
    case mm0.formula.imp_ : φ ψ φ_ih ψ_ih
    {
      unfold mm0.formula.subst,
      simp only [imp_to_fol_formula],
      apply fol.proof_eqv_compat_imp,
      {
        exact φ_ih,
      },
      {
        exact ψ_ih,
      }
    },
    case mm0.formula.eq_ : x y
    {
      apply fol.proof_eqv_refl,
      unfold mm0.formula.subst,
      simp only [eq_to_fol_formula],
      unfold fol.formula.subst,
    },
    case mm0.formula.forall_ : x φ φ_ih
    {
      unfold mm0.formula.subst,
      simp only [forall_to_fol_formula],
      apply fol.proof_eqv_compat_forall,
      {
        refl,
      },
      {
        exact φ_ih,
      }
    },
    case mm0.formula.def_ : name args
    {
      have s1 : (mm0.formula.def_ name args).meta_var_set = ∅,
      refl,

      rewrite to_fol_formula_no_meta_var (fol.formula.subst σ_inv ∘ mm0.formula.to_fol_formula M (E_hd :: E_tl) ∘ τ) M (E_hd :: E_tl) (mm0.formula.def_ name args) s1,
      rewrite mm0.no_meta_var_subst (mm0.formula.def_ name args) σ τ mm0.formula.meta_var_ s1,

      by_cases c1 : name = E_hd.name
        ∧ ∃ (σ : mm0.instantiation), args = list.map σ.val E_hd.args,
      {
        obtain ⟨σ_1, c_1_1, c_1_2⟩ := not_nil_def_to_fol_formula' M E_hd E_tl name args c1,

        unfold mm0.formula.subst,

        have s2 : (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q).meta_var_set = ∅,
        apply mm0.subst_no_meta_var,
        apply mm0.no_meta_var_imp_meta_var_set_is_empty E_hd.q E_hd.args E_hd.nf,

        by_cases c2 : name = E_hd.name
          ∧ ∃ (σ_1 : mm0.instantiation), list.map σ.val args = list.map σ_1.val E_hd.args,
        {
          obtain ⟨σ_2, c_2_1, c_2_2⟩ := not_nil_def_to_fol_formula' M E_hd E_tl name (list.map σ.val args) c2,

          clear c2,

          rewrite c_1_2,
          clear c_1_2,

          rewrite c_2_2,
          clear c_2_2,

          rewrite c_1_1 at c_2_1,
          simp only [list.map_map] at c_2_1,

          specialize E_ih (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q),

          rewrite to_fol_formula_no_meta_var (fol.formula.subst σ_inv ∘ mm0.formula.to_fol_formula M E_tl ∘ τ) M E_tl (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q) s2 at E_ih,
          rewrite mm0.no_meta_var_subst (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q) σ τ mm0.formula.meta_var_ s2 at E_ih,

          rewrite mm0.subst_comp at E_ih,

          apply fol.proof_eqv_trans
            -- left goal
            (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst σ_2 mm0.formula.meta_var_ E_hd.q))
            -- right IH
            (fol.formula.subst σ (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q)))
            -- right goal
            (fol.formula.subst σ (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q))),
          {
            apply fol.proof_eqv_trans
              -- left goal
              (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst σ_2 mm0.formula.meta_var_ E_hd.q))
              -- left IH
              (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst (σ.comp σ_1) mm0.formula.meta_var_ E_hd.q))
              -- right IH
              (fol.formula.subst σ (mm0.formula.to_fol_formula M E_tl (mm0.formula.subst σ_1 mm0.formula.meta_var_ E_hd.q))),
            {
              apply proof_eqv_to_fol_formula_subst E_hd.q E_hd.args M E_tl _ _ E_hd.nf,
              rewrite <- list.map_eq_map_iff,
              symmetry,
              exact c_2_1,
            },
            {
              apply E_ih,
            },
          },
          {
            apply fol.proof_eqv_refl,
            refl,
          },
        },
        {
          cases c1,
          rewrite c_1_1 at c2,
          push_neg at c2,
          exfalso,
          apply c2 c1_left (mm0.instantiation.comp σ σ_1),
          simp only [list.map_map],
          refl,
        },
      },
      {
        unfold mm0.formula.subst,

        have s2 : (mm0.formula.subst σ mm0.formula.meta_var_ E_hd.q).meta_var_set = ∅,
        apply mm0.subst_no_meta_var,
        apply mm0.no_meta_var_imp_meta_var_set_is_empty E_hd.q E_hd.args E_hd.nf,

        by_cases c2 : name = E_hd.name
          ∧ ∃ (σ_1 : mm0.instantiation), list.map σ.val args = list.map σ_1.val E_hd.args,
        {
          obtain ⟨σ_2, c_2_1, c_2_2⟩ := not_nil_def_to_fol_formula' M E_hd E_tl name (list.map σ.val args) c2,
          cases c2,

          have s1 : E_hd.args.length = args.length,
          transitivity (list.map σ.val args).length,
          {
            transitivity (list.map σ_2.val E_hd.args).length,
            {
              symmetry,
              apply list.length_map,
            },
            {
              rewrite c_2_1,
            },
          },
          {
            apply list.length_map,
          },

          obtain ⟨σ_inv, σ_inv_prop⟩ := mm0.instantiation.exists_inverse σ,

          have s2 : (list.map σ_inv.val (list.map σ.val args)).nodup,
          apply list.nodup.map (mm0.instantiation_injective σ_inv),
          rewrite c_2_1,
          exact list.nodup.map (mm0.instantiation_injective σ_2) E_hd.nodup,

          have s3 : args.nodup,
          simp only [list.map_map] at s2,
          cases σ_inv_prop,
          rewrite σ_inv_prop_right at s2,
          simp only [list.map_id] at s2,
          exact s2,

          obtain s4 := nodup_eq_len_imp_eqv E_hd.args args s1 E_hd.nodup s3,

          exfalso,
          apply c1,
          split,
          {
            exact c2_left,
          },
          {
            apply exists.elim s4,
            intros f s4_1,
            let blah : mm0.instantiation := ⟨ f.to_fun,
              begin
                apply exists.intro f.inv_fun,
                split,
                {
                  simp only [equiv.to_fun_as_coe, equiv.inv_fun_as_coe, equiv.self_comp_symm],
                },
                {
                  simp only [equiv.inv_fun_as_coe, equiv.to_fun_as_coe, equiv.symm_comp_self],
                }
              end ⟩,
            apply exists.intro blah,
            symmetry,
            exact s4_1,
          }
        },
        {
          rewrite to_fol_formula_env_ext M E_hd E_tl name args c1,
          rewrite to_fol_formula_env_ext M E_hd E_tl name (list.map σ.val args) c2,

          specialize E_ih (mm0.formula.def_ name args),
          rewrite to_fol_formula_no_meta_var (fol.formula.subst σ_inv ∘ mm0.formula.to_fol_formula M E_tl ∘ τ) M E_tl (mm0.formula.def_ name args) s1 at E_ih,
          rewrite mm0.no_meta_var_subst (mm0.formula.def_ name args) σ τ mm0.formula.meta_var_ s1 at E_ih,
          unfold mm0.formula.subst at E_ih,
          exact E_ih,
        },
      },
    },
  },
end

lemma is_conv_imp_is_proof_eqv
  (M : mm0.meta_var_name → fol.formula)
  (E : mm0.env)
  (φ φ' : mm0.formula)
  (h1 : mm0.is_conv E φ φ')
  (h2 : E.well_formed) :
  fol.proof_eqv (mm0.formula.to_fol_formula M E φ) (mm0.formula.to_fol_formula M E φ') :=
begin
  induction h1,
  case mm0.is_conv.conv_refl : h1
  {
    apply fol.proof_eqv_refl,
    refl,
  },
  case mm0.is_conv.conv_symm : h1_φ h1_φ' h1_1 h1_ih
  {
    apply fol.proof_eqv_symm _ _ h1_ih,
  },
  case mm0.is_conv.conv_trans : h1_φ h1_φ' h1_φ'' h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    apply fol.proof_eqv_trans _ _ _ h1_ih_1 h1_ih_2,
  },
  case mm0.is_conv.conv_not : h1_φ h1_φ' h1_1 h1_ih
  {
    simp only [not_to_fol_formula],
    apply fol.proof_eqv_compat_not _ _ h1_ih,
  },
  case mm0.is_conv.conv_imp : h1_φ h1_φ' h1_ψ h1_ψ' h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    simp only [imp_to_fol_formula],
    apply fol.proof_eqv_compat_imp _ _ _ _ h1_ih_1 h1_ih_2,
  },
  case mm0.is_conv.conv_forall : h1_x h1_φ h1_φ' h1_1 h1_ih
  {
    simp only [forall_to_fol_formula],
    apply fol.proof_eqv_compat_forall,
    refl,
    exact h1_ih,
  },
  case mm0.is_conv.conv_unfold : h1_d h1_σ h1_1
  {
    induction E,
    case list.nil
    {
      simp only [list.not_mem_nil] at h1_1,
      contradiction,
    },
    case list.cons : E_hd E_tl E_ih
    {
      simp only [list.mem_cons_iff] at h1_1,
      cases h1_1,
      {
        by_cases c1 : h1_d.name = E_hd.name
          ∧ ∃ (σ : mm0.instantiation), list.map h1_σ.val h1_d.args = list.map σ.val E_hd.args,
        {
          obtain ⟨σ_1, c_1_1, c_1_2⟩ := not_nil_def_to_fol_formula' M E_hd E_tl h1_d.name (list.map h1_σ.val h1_d.args) c1,
          rewrite c_1_2,
          clear c_1_2,
          rewrite h1_1,

          have s1 : ∃ (E1 : mm0.env), E_hd :: E_tl = E1 ++ E_tl,
          apply exists.intro [E_hd],
          simp only [list.singleton_append, eq_self_iff_true, and_self],

          have s2 : mm0.formula.is_meta_var_or_all_def_in_env E_tl (mm0.formula.subst h1_σ mm0.formula.meta_var_ E_hd.q),
          unfold mm0.env.well_formed at h2,
          cases h2,
          cases h2_right,
          apply mm0.is_meta_var_or_all_def_in_env_subst E_hd.q E_tl h1_σ h2_right_left,

          rewrite <- to_fol_formula_env_ext' M E_tl (E_hd :: E_tl) (mm0.formula.subst h1_σ mm0.formula.meta_var_ E_hd.q) s1 s2 h2,
          clear s1,
          clear s2,

          rewrite h1_1 at c_1_1,

          apply proof_eqv_to_fol_formula_subst E_hd.q E_hd.args M E_tl σ_1 h1_σ E_hd.nf,
          simp only [list.map_eq_map_iff] at c_1_1,
          intros x a1,
          symmetry,
          exact c_1_1 x a1,
        },
        {
          exfalso,
          apply c1,
          rewrite h1_1,
          split,
          {
            refl,
          },
          {
            apply exists.intro h1_σ,
            refl,
          }
        }
      },
      {
        by_cases c1 : h1_d.name = E_hd.name
          ∧ ∃ (σ : mm0.instantiation), list.map h1_σ.val h1_d.args = list.map σ.val E_hd.args,
        {
          unfold mm0.env.well_formed at h2,
          cases h2,
          cases h2_right,

          obtain ⟨σ_1, c_1_1, c_1_2⟩ := not_nil_def_to_fol_formula' M E_hd E_tl h1_d.name (list.map h1_σ.val h1_d.args) c1,
          rewrite c_1_2,
          clear c_1_2,

          exfalso,
          apply h2_left h1_d h1_1,
          {
            cases c1,
            symmetry,
            exact c1_left,
          },
          {
            have s1 : (list.map h1_σ.val h1_d.args).length = h1_d.args.length,
            simp only [list.length_map],

            have s2 : (list.map σ_1.val E_hd.args).length = E_hd.args.length,
            simp only [list.length_map],

            rewrite <- s1,
            rewrite <- s2,
            symmetry,
            rewrite c_1_1,
          }
        },
        {
          have s1 : ∃ (E1 : mm0.env), E_hd :: E_tl = E1 ++ E_tl,
          apply exists.intro [E_hd],
          simp only [list.singleton_append, eq_self_iff_true, and_self],

          have s2 : mm0.formula.is_meta_var_or_all_def_in_env E_tl (mm0.formula.subst h1_σ mm0.formula.meta_var_ h1_d.q),
          unfold mm0.env.well_formed at h2,
          cases h2,
          cases h2_right,
          apply mm0.is_meta_var_or_all_def_in_env_subst h1_d.q E_tl h1_σ,
          apply mm0.def_in_env_imp_is_meta_var_or_all_def_in_env E_tl h1_d h2_right_right h1_1,

          rewrite to_fol_formula_env_ext M E_hd E_tl h1_d.name (list.map h1_σ.val h1_d.args) c1,
          rewrite <- to_fol_formula_env_ext' M E_tl (E_hd :: E_tl) (mm0.formula.subst h1_σ mm0.formula.meta_var_ h1_d.q) s1 s2 h2,

          cases h2,
          cases h2_right,
          exact E_ih h2_right_right h1_1,
        }
      }
    },
  },
end

theorem conservative
  (E : mm0.env)
  (Γ : list (mm0.var_name × mm0.meta_var_name))
  (Δ : list mm0.formula)
  (φ : mm0.formula)
  (M : mm0.meta_var_name → fol.formula)
  (h1 : mm0.is_proof E Γ Δ φ)
  (h2 : ∀ (x : mm0.var_name) (X : mm0.meta_var_name), (x, X) ∈ Γ → fol.not_free x (M X))
  (h3 : ∀ (ψ : mm0.formula), ψ ∈ Δ → fol.is_proof (mm0.formula.to_fol_formula M E ψ))
  (h4 : E.well_formed) :
  fol.is_proof (mm0.formula.to_fol_formula M E φ) :=
begin
  induction h1 generalizing M,
  case is_proof.hyp : h1_Γ h1_Δ h1_φ h1_1 h1_2
  {
    exact h3 h1_φ h1_2,
  },
  case is_proof.mp : h1_Γ h1_Δ h1_φ h1_ψ h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    simp only [imp_to_fol_formula] at h1_ih_2,

    apply fol.is_proof.mp (mm0.formula.to_fol_formula M E h1_φ) (mm0.formula.to_fol_formula M E h1_ψ),
    {
      exact h1_ih_1 M h2 h3,
    },
    {
      exact h1_ih_2 M h2 h3,
    }
  },
  case is_proof.prop_1 : h1_Γ h1_Δ h1_φ h1_ψ h1_1 h1_2
  {
    simp only [imp_to_fol_formula],
    apply fol.is_proof.prop_1,
  },
  case is_proof.prop_2 : h1_Γ h1_Δ h1_φ h1_ψ h1_χ h1_1 h1_2 h1_3
  {
    simp only [imp_to_fol_formula],
    apply fol.is_proof.prop_2,
  },
  case is_proof.prop_3 : h1_Γ h1_Δ h1_φ h1_ψ h1_1 h1_2
  {
    simp only [imp_to_fol_formula, not_to_fol_formula],
    apply fol.is_proof.prop_3,
  },
  case is_proof.gen : h1_Γ h1_Δ h1_φ h1_x h1_1 h1_ih
  {
    simp only [forall_to_fol_formula],
    apply fol.is_proof.gen,
    exact h1_ih M h2 h3,
  },
  case is_proof.pred_1 : h1_Γ h1_Δ h1_φ h1_ψ h1_x h1_1 h1_2
  {
    simp only [imp_to_fol_formula, forall_to_fol_formula],
    apply fol.is_proof.pred_1,
  },
  case is_proof.pred_2 : h1_Γ h1_Δ h1_φ h1_x h1_1 h1_2
  {
    simp only [imp_to_fol_formula, forall_to_fol_formula],
    apply fol.is_proof.pred_2,
    exact mm0_not_free_imp_fol_not_free M h1_Γ E h1_x h1_φ h1_2 h2,
  },
  case is_proof.eq_1 : h1_Γ h1_Δ h1_x h1_y h1_1
  {
    unfold mm0.exists_,
    simp only [not_to_fol_formula, forall_to_fol_formula, eq_to_fol_formula],
    apply fol.is_proof.eq_1,
    exact h1_1,
  },
  case is_proof.eq_2 : h1_Γ h1_Δ h1_x h1_y h1_z
  {
    simp only [imp_to_fol_formula, eq_to_fol_formula],
    apply fol.is_proof.eq_2,
  },
  case is_proof.thm : h1_Γ h1_Γ' h1_Δ h1_Δ' h1_φ h1_σ h1_τ h1_1 h1_2 h1_3 h1_4 h1_ih_1 h1_ih_2
  {
    obtain ⟨h1_σ', a1⟩ := h1_σ.2,
    cases a1,

    let h1_σ_inv : mm0.instantiation :=
      ⟨h1_σ', begin apply exists.intro h1_σ.val, exact and.intro a1_right a1_left, end⟩,

    dsimp at *,

    obtain s1 := proof_eqv_subst_to_fol_formula_subst h1_φ M E h1_σ h1_σ_inv h1_τ a1_left a1_right,
    unfold fol.proof_eqv at s1,
    cases s1,

    apply fol.is_proof.mp _ _ _ s1_right,
    apply fol.is_proof_subst_left,
    apply h1_ih_2,
    {
      intros x X a2,

      have s2 : x = (h1_σ_inv.val ∘ h1_σ.val) x,
      simp only [subtype.val_eq_coe],
      rewrite a1_right,
      simp only [id.def],

      rewrite s2,
      simp only [function.comp_app],
      apply fol.not_free_subst h1_σ_inv,
      exact mm0_not_free_imp_fol_not_free M h1_Γ' E (h1_σ.val x) (h1_τ X) (h1_2 x X a2) h2,
    },
    {
      intros ψ a2,

      obtain s3 := proof_eqv_subst_to_fol_formula_subst ψ M E h1_σ h1_σ_inv h1_τ a1_left a1_right,
      unfold fol.proof_eqv at s3,
      cases s3,
      apply fol.is_proof_subst_right _ h1_σ,
      specialize h1_ih_1 ψ a2 M h2 h3,
      apply fol.is_proof.mp _ _ h1_ih_1 s3_left,
    }
  },
  case is_proof.conv : h1_Γ h1_Δ h1_φ h1_φ' h1_1 h1_2 h1_3 h1_ih
  {
    specialize h1_ih M h2 h3,
    obtain s1 := is_conv_imp_is_proof_eqv M _ _ _ h1_3 h4,
    unfold fol.proof_eqv at s1,
    cases s1,
    apply fol.is_proof.mp _ _ h1_ih s1_left,
  },
end


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.functor.const
import category_theory.discrete_category

/-!
# The category `discrete punit`

We define `star : C ⥤ discrete punit` sending everything to `punit.star`,
show that any two functors to `discrete punit` are naturally isomorphic,
and construct the equivalence `(discrete punit ⥤ C) ≌ C`.
-/

universes v u -- morphism levels before object levels. See note [category_theory universes].

namespace category_theory
variables (C : Type u) [category.{v} C]

namespace functor

/-- The constant functor sending everything to `punit.star`. -/
@[simps]
def star : C ⥤ discrete punit :=
(functor.const _).obj punit.star

variable {C}
/-- Any two functors to `discrete punit` are isomorphic. -/
@[simps]
def punit_ext (F G : C ⥤ discrete punit) : F ≅ G :=
nat_iso.of_components (λ _, eq_to_iso dec_trivial) (λ _ _ _, dec_trivial)

/--
Any two functors to `discrete punit` are *equal*.
You probably want to use `punit_ext` instead of this.
-/
lemma punit_ext' (F G : C ⥤ discrete punit) : F = G :=
functor.ext (λ _, dec_trivial) (λ _ _ _, dec_trivial)

/-- The functor from `discrete punit` sending everything to the given object. -/
abbreviation from_punit (X : C) : discrete punit.{v+1} ⥤ C :=
(functor.const _).obj X

/-- Functors from `discrete punit` are equivalent to the category itself. -/
@[simps]
def equiv : (discrete punit ⥤ C) ≌ C :=
{ functor :=
  { obj := λ F, F.obj punit.star,
    map := λ F G θ, θ.app punit.star },
  inverse := functor.const _,
  unit_iso :=
  begin
    apply nat_iso.of_components _ _,
    intro X,
    apply discrete.nat_iso,
    rintro ⟨⟩,
    apply iso.refl _,
    intros,
    ext ⟨⟩,
    simp,
  end,
  counit_iso :=
  begin
    refine nat_iso.of_components iso.refl _,
    intros X Y f,
    dsimp, simp,  -- See note [dsimp, simp].
  end }

end functor

/-- A category being equivalent to `punit` is equivalent to it having a unique morphism between
  any two objects. (In fact, such a category is also a groupoid; see `groupoid.of_hom_unique`) -/
theorem equiv_punit_iff_unique :
  nonempty (C ≌ discrete punit) ↔ (nonempty C) ∧ (∀ x y : C, nonempty $ unique (x ⟶ y)) :=
begin
  split,
  { rintro ⟨h⟩,
    refine ⟨⟨h.inverse.obj punit.star⟩, λ x y, nonempty.intro _⟩,
    apply (unique_of_subsingleton _), swap,
    { have hx : x ⟶ h.inverse.obj punit.star := by convert h.unit.app x,
      have hy : h.inverse.obj punit.star ⟶ y := by convert h.unit_inv.app y,
      exact hx ≫ hy, },
    have : ∀ z, z = h.unit.app x ≫ (h.functor ⋙ h.inverse).map z ≫ h.unit_inv.app y,
    { intro z, simpa using congr_arg (≫ (h.unit_inv.app y)) (h.unit.naturality z), },
    apply subsingleton.intro,
    intros a b,
    rw [this a, this b],
    simp only [functor.comp_map], congr, },
  { rintro ⟨⟨p⟩, h⟩,
    haveI := λ x y, (h x y).some,
    refine nonempty.intro (category_theory.equivalence.mk
      ((functor.const _).obj punit.star) ((functor.const _).obj p) _ (by apply functor.punit_ext)),
    exact nat_iso.of_components (λ _, { hom := default, inv := default }) (λ _ _ _, by tidy), },
end

end category_theory


import data.int.basic
import tactic.lift

/-! Some tests of the `lift` tactic. -/

example (n m k x z u : ℤ) (hn : 0 < n) (hk : 0 ≤ k + n) (hu : 0 ≤ u)
  (h : k + n = 2 + x) (f : false) :
  k + n = m + x :=
begin
  lift n to ℕ using le_of_lt hn,
    guard_target (k + ↑n = m + x), guard_hyp hn : (0 : ℤ) < ↑n,
  lift m to ℕ,
    guard_target (k + ↑n = ↑m + x), tactic.swap, guard_target (0 ≤ m), tactic.swap,
    tactic.num_goals >>= λ n, guard (n = 2),
  lift (k + n) to ℕ using hk with l hl,
    guard_hyp l : ℕ, guard_hyp hl : ↑l = k + ↑n, guard_target (↑l = ↑m + x),
    tactic.success_if_fail (tactic.get_local `hk),
  lift x to ℕ with y hy,
    guard_hyp y : ℕ, guard_hyp hy : ↑y = x, guard_target (↑l = ↑m + x),
  lift z to ℕ with w,
    guard_hyp w : ℕ, tactic.success_if_fail (tactic.get_local `z),
  lift u to ℕ using hu with u rfl hu,
    guard_hyp hu : (0 : ℤ) ≤ ↑u,

  all_goals { exfalso, assumption },
end

-- test lift of functions
example (α : Type*) (f : α → ℤ) (hf : ∀ a, 0 ≤ f a) (hf' : ∀ a, f a < 1) (a : α) : 0 ≤ 2 * f a :=
begin
  lift f to α → ℕ using hf,
    guard_target ((0:ℤ) ≤ 2 * (λ i : α, (f i : ℤ)) a),
    guard_hyp hf' : ∀ a, ((λ i : α, (f i:ℤ)) a) < 1,
  exact int.coe_nat_nonneg _
end

-- fail gracefully when the lifted variable is a local definition
example : let n : ℤ := 3 in n = n :=
begin
  intro n,
  success_if_fail_with_msg { lift n to ℕ }
    ("Cannot substitute variable n, it is a local definition. " ++
    "If you really want to do this, use `clear_value` first."),
  refl
end

instance can_lift_unit : can_lift unit unit :=
⟨id, λ x, true, λ x _, ⟨x, rfl⟩⟩

/- test whether new instances of `can_lift` are added as simp lemmas -/
run_cmd do l ← can_lift_attr.get_cache, guard (`can_lift_unit ∈ l)

/- test error messages -/
example (n : ℤ) (hn : 0 < n) : true :=
begin
  success_if_fail_with_msg {lift n to ℕ using hn} "lift tactic failed.
invalid type ascription, term has type\n  0 < n\nbut is expected to have type\n  0 ≤ n",
  success_if_fail_with_msg {lift (n : option ℤ) to ℕ}
    "Failed to find a lift from option ℤ to ℕ. Provide an instance of\n  can_lift (option ℤ) ℕ",
  trivial
end

example (n : ℤ) : ℕ :=
begin
  success_if_fail_with_msg {lift n to ℕ}
    "lift tactic failed. Tactic is only applicable when the target is a proposition.",
  exact 0
end

instance can_lift_subtype (R : Type*) (P : R → Prop) : can_lift R {x // P x} :=
{ coe := coe,
  cond := λ x, P x,
  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }

instance can_lift_set (R : Type*) (s : set R) : can_lift R s :=
{ coe := coe,
  cond := λ x, x ∈ s,
  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }

example {R : Type*} {P : R → Prop} (x : R) (hx : P x) : true :=
by { lift x to {x // P x} using hx with y, trivial }

/-! Test that `lift` elaborates `s` as a type, not as a set. -/
example {R : Type*} {s : set R} (x : R) (hx : x ∈ s) : true :=
by { lift x to s using hx with y, trivial }

example (n : ℤ) (hn : 0 ≤ n) : true :=
by { lift n to ℕ, trivial, exact hn }

example (n : ℤ) (hn : 0 ≤ n) : true :=
by { lift n to ℕ using hn, trivial }

example (n : ℤ) (hn : n ≥ 0) : true :=
by { lift n to ℕ using ge.le _, trivial, guard_target (n ≥ 0), exact hn }

example (n : ℤ) (hn : 0 ≤ 1 * n) : true :=
begin
  lift n to ℕ using by { simpa [int.one_mul] using hn } with k,
  -- the above braces are optional, but it would be bad style to remove them (see next example)
  guard_hyp hn : 0 ≤ 1 * ((k : ℕ) : ℤ),
  trivial
end

example (n : ℤ) (hn : 0 ≤ n ↔ true) : true :=
begin
  lift n to ℕ using by { simp [hn] } with k, -- the braces are not optional here
  trivial
end


/-
Copyright (c) 2015 Joe Hendrix. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Sebastian Ullrich
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.vector2
import Mathlib.data.nat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Basic operations on bitvectors

This is a work-in-progress, and contains additions to other theories.

This file was moved to mathlib from core Lean in the switch to Lean 3.20.0c. It is not fully in compliance with mathlib style standards.
-/

/-- `bitvec n` is a `vector` of `bool` with length `n`. -/
def bitvec (n : ℕ) :=
  vector Bool n

namespace bitvec

/-- Create a zero bitvector -/
protected def zero (n : ℕ) : bitvec n :=
  vector.repeat false n

/-- Create a bitvector of length `n` whose `n-1`st entry is 1 and other entries are 0. -/
protected def one (n : ℕ) : bitvec n :=
  sorry

/-- Create a bitvector from another with a provably equal length. -/
protected def cong {a : ℕ} {b : ℕ} (h : a = b) : bitvec a → bitvec b :=
  sorry

/-- `bitvec` specific version of `vector.append` -/
def append {m : ℕ} {n : ℕ} : bitvec m → bitvec n → bitvec (m + n) :=
  vector.append

/-! ### Shift operations -/

/-- `shl x i` is the bitvector obtained by left-shifting `x` `i` times and padding with `ff`.
If `x.length < i` then this will return the all-`ff`s bitvector. -/
def shl {n : ℕ} (x : bitvec n) (i : ℕ) : bitvec n :=
  bitvec.cong sorry (vector.append (vector.drop i x) (vector.repeat false (min n i)))

/-- `fill_shr x i fill` is the bitvector obtained by right-shifting `x` `i` times and then
padding with `fill : bool`. If `x.length < i` then this will return the constant `fill`
bitvector. -/
def fill_shr {n : ℕ} (x : bitvec n) (i : ℕ) (fill : Bool) : bitvec n :=
  bitvec.cong sorry (vector.append (vector.repeat fill (min n i)) (vector.take (n - i) x))

/-- unsigned shift right -/
def ushr {n : ℕ} (x : bitvec n) (i : ℕ) : bitvec n :=
  fill_shr x i false

/-- signed shift right -/
def sshr {m : ℕ} : bitvec m → ℕ → bitvec m :=
  sorry

/-! ### Bitwise operations -/

/-- bitwise not -/
/-- bitwise and -/
def not {n : ℕ} : bitvec n → bitvec n :=
  vector.map bnot

/-- bitwise or -/
def and {n : ℕ} : bitvec n → bitvec n → bitvec n :=
  vector.map₂ band

/-- bitwise xor -/
def or {n : ℕ} : bitvec n → bitvec n → bitvec n :=
  vector.map₂ bor

def xor {n : ℕ} : bitvec n → bitvec n → bitvec n :=
  vector.map₂ bxor

/-! ### Arithmetic operators -/

/-- `xor3 x y c` is `((x XOR y) XOR c)`. -/
/-- `carry x y c` is `x && y || x && c || y && c`. -/
protected def xor3 (x : Bool) (y : Bool) (c : Bool) : Bool :=
  bxor (bxor x y) c

protected def carry (x : Bool) (y : Bool) (c : Bool) : Bool :=
  x && y || x && c || y && c

/-- `neg x` is the two's complement of `x`. -/
protected def neg {n : ℕ} (x : bitvec n) : bitvec n :=
  let f : Bool → Bool → Bool × Bool := fun (y c : Bool) => (y || c, bxor y c);
  prod.snd (vector.map_accumr f x false)

/-- Add with carry (no overflow) -/
def adc {n : ℕ} (x : bitvec n) (y : bitvec n) (c : Bool) : bitvec (n + 1) :=
  let f : Bool → Bool → Bool → Bool × Bool := fun (x y c : Bool) => (bitvec.carry x y c, bitvec.xor3 x y c);
  sorry

/-- The sum of two bitvectors -/
protected def add {n : ℕ} (x : bitvec n) (y : bitvec n) : bitvec n :=
  vector.tail (adc x y false)

/-- Subtract with borrow -/
def sbb {n : ℕ} (x : bitvec n) (y : bitvec n) (b : Bool) : Bool × bitvec n :=
  let f : Bool → Bool → Bool → Bool × Bool := fun (x y c : Bool) => (bitvec.carry (!x) y c, bitvec.xor3 x y c);
  vector.map_accumr₂ f x y b

/-- The difference of two bitvectors -/
protected def sub {n : ℕ} (x : bitvec n) (y : bitvec n) : bitvec n :=
  prod.snd (sbb x y false)

protected instance has_zero {n : ℕ} : HasZero (bitvec n) :=
  { zero := bitvec.zero n }

protected instance has_one {n : ℕ} : HasOne (bitvec n) :=
  { one := bitvec.one n }

protected instance has_add {n : ℕ} : Add (bitvec n) :=
  { add := bitvec.add }

protected instance has_sub {n : ℕ} : Sub (bitvec n) :=
  { sub := bitvec.sub }

protected instance has_neg {n : ℕ} : Neg (bitvec n) :=
  { neg := bitvec.neg }

/-- The product of two bitvectors -/
protected def mul {n : ℕ} (x : bitvec n) (y : bitvec n) : bitvec n :=
  let f : bitvec n → Bool → bitvec n := fun (r : bitvec n) (b : Bool) => cond b (r + r + y) (r + r);
  list.foldl f 0 (vector.to_list x)

protected instance has_mul {n : ℕ} : Mul (bitvec n) :=
  { mul := bitvec.mul }

/-! ### Comparison operators -/

/-- `uborrow x y` returns `tt` iff the "subtract with borrow" operation on `x`, `y` and `ff`
required a borrow. -/
def uborrow {n : ℕ} (x : bitvec n) (y : bitvec n) : Bool :=
  prod.fst (sbb x y false)

/-- unsigned less-than proposition -/
/-- unsigned greater-than proposition -/
def ult {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ↥(uborrow x y)

def ugt {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ult y x

/-- unsigned less-than-or-equal-to proposition -/
/-- unsigned greater-than-or-equal-to proposition -/
def ule {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ¬ult y x

def uge {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ule y x

/-- `sborrow x y` returns `tt` iff `x < y` as two's complement integers -/
def sborrow {n : ℕ} : bitvec n → bitvec n → Bool :=
  sorry

/-- signed less-than proposition -/
/-- signed greater-than proposition -/
def slt {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ↥(sborrow x y)

/-- signed less-than-or-equal-to proposition -/
def sgt {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  slt y x

/-- signed greater-than-or-equal-to proposition -/
def sle {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  ¬slt y x

def sge {n : ℕ} (x : bitvec n) (y : bitvec n) :=
  sle y x

/-! ### Conversion to `nat` and `int` -/

/-- Create a bitvector from a `nat` -/
protected def of_nat (n : ℕ) : ℕ → bitvec n :=
  sorry

/-- Create a bitvector in the two's complement representation from an `int` -/
protected def of_int (n : ℕ) : ℤ → bitvec (Nat.succ n) :=
  sorry

/-- `add_lsb r b` is `r + r + 1` if `b` is `tt` and `r + r` otherwise. -/
def add_lsb (r : ℕ) (b : Bool) : ℕ :=
  r + r + cond b 1 0

/-- Given a `list` of `bool`s, return the `nat` they represent as a list of binary digits. -/
def bits_to_nat (v : List Bool) : ℕ :=
  list.foldl add_lsb 0 v

/-- Return the natural number encoded by the input bitvector -/
protected def to_nat {n : ℕ} (v : bitvec n) : ℕ :=
  bits_to_nat (vector.to_list v)

theorem bits_to_nat_to_list {n : ℕ} (x : bitvec n) : bitvec.to_nat x = bits_to_nat (vector.to_list x) :=
  rfl

-- mul_left_comm

theorem to_nat_append {m : ℕ} (xs : bitvec m) (b : Bool) : bitvec.to_nat (vector.append xs (b::ᵥvector.nil)) = bitvec.to_nat xs * bit0 1 + bitvec.to_nat (b::ᵥvector.nil) := sorry

theorem bits_to_nat_to_bool (n : ℕ) : bitvec.to_nat (to_bool (n % bit0 1 = 1)::ᵥvector.nil) = n % bit0 1 := sorry

theorem of_nat_succ {k : ℕ} {n : ℕ} : bitvec.of_nat (Nat.succ k) n = vector.append (bitvec.of_nat k (n / bit0 1)) (to_bool (n % bit0 1 = 1)::ᵥvector.nil) :=
  rfl

theorem to_nat_of_nat {k : ℕ} {n : ℕ} : bitvec.to_nat (bitvec.of_nat k n) = n % bit0 1 ^ k := sorry

/-- Return the integer encoded by the input bitvector -/
protected def to_int {n : ℕ} : bitvec n → ℤ :=
  sorry

/-! ### Miscellaneous instances -/

protected instance has_repr (n : ℕ) : has_repr (bitvec n) :=
  has_repr.mk repr

end bitvec

protected instance bitvec.ult.decidable {n : ℕ} {x : bitvec n} {y : bitvec n} : Decidable (bitvec.ult x y) :=
  bool.decidable_eq (bitvec.uborrow x y) tt

protected instance bitvec.ugt.decidable {n : ℕ} {x : bitvec n} {y : bitvec n} : Decidable (bitvec.ugt x y) :=
  bool.decidable_eq (bitvec.uborrow y x) tt


import Mathlib.Tactic.Cases
import Mathlib.Init.Logic
import Mathlib.Init.Data.Nat.Notation

example (x : α × β × γ) : True := by
  cases' x with a b; cases' b with b c
  guard_hyp a : α
  guard_hyp b : β
  guard_hyp c : γ
  trivial

example {α β γ : Type u} (x : α × β × γ) : True := by
  cases' h: x with a b
  guard_hyp a : α
  guard_hyp b : β × γ
  guard_hyp x : α × β × γ
  guard_hyp h : x = (a, b)
  trivial

noncomputable def my_rec :
  {motive : ℕ → Sort u_1} →
  (zee : motive 0) →
  (soo : (n : ℕ) → motive n → motive (n + 1)) →
  (t : ℕ) → motive t := @Nat.rec

example (x : ℕ) : True := by
  cases' h: x using my_rec with y
  case zee => guard_hyp h : x = 0; trivial
  case soo => guard_hyp h : x = y + 1; trivial

inductive Foo (α β)
| A (a : α)
| B (a' : α) (b' : β)
| C (a'' : α) (b'' : β) (c'' : Foo α β)

example (x : Foo α β) : True := by
  cases' x with a₀ a₁ _ a₂ b₂ c₂
  · guard_hyp a₀ : α; trivial
  · guard_hyp a₁ : α; have : β := (by assumption); trivial
  · guard_hyp a₂ : α; guard_hyp b₂ : β; guard_hyp c₂ : Foo α β; trivial

inductive Bar : ℕ → Type
| A (a b : Nat) : Bar 1
| B (c d : Nat) : Bar (c + 1) → Bar c

example (x : Bar 0) : True := by
  cases' x with a b c d h
  · guard_hyp d : ℕ; guard_hyp h : Bar (0 + 1); trivial

example (n : Nat) : n = n := by
  induction' n with n ih
  · guard_target = Nat.zero = Nat.zero; rfl
  · guard_hyp n : Nat; guard_hyp ih : n = n
    guard_target = Nat.succ n = Nat.succ n; exact congr_arg _ ih

example (n : Nat) (h : n < 5) : n = n := by
  induction' n with n ih
  · guard_target = Nat.zero = Nat.zero; rfl
  · guard_hyp n : Nat; guard_hyp ih : n < 5 → n = n; guard_hyp h : Nat.succ n < 5
    guard_target = Nat.succ n = Nat.succ n; rfl

example (n : Nat) {m} (h : m < 5) : n = n := by
  induction' n with n ih
  · guard_target = Nat.zero = Nat.zero; rfl
  · guard_hyp n : Nat; guard_hyp ih : n = n; guard_hyp h : m < 5
    guard_target = Nat.succ n = Nat.succ n; rfl

example (n : Nat) {m} (h : m < 5) : n = n := by
  induction' n with n ih generalizing m
  · guard_target = Nat.zero = Nat.zero; rfl
  · guard_hyp n : Nat; guard_hyp ih : ∀ {m}, m < 5 → n = n; guard_hyp h : m < 5
    guard_target = Nat.succ n = Nat.succ n; rfl

example (n : Nat) : n = n := by
  induction' e : n with m ih
  · guard_hyp e : n = Nat.zero; guard_target = Nat.zero = Nat.zero; rfl
  · guard_hyp m : Nat; guard_hyp ih : n = m → m = m
    guard_hyp e : n = Nat.succ m; guard_target = Nat.succ m = Nat.succ m; rfl

example (n : Nat) : n = n := by
  induction' e : n using my_rec with m ih
  case zee =>
    guard_hyp e : n = 0; guard_target = 0 = 0; rfl
  case soo =>
    guard_hyp m : Nat; guard_hyp ih : n = m → m = m
    guard_hyp e : n = m + 1; guard_target = m + 1 = m + 1; rfl

example (x : Foo α Nat) : True := by
  induction' x with a a' b' a'' b'' c'' ih
  case A => guard_hyp a : α; trivial
  case B => guard_hyp a' : α; guard_hyp b' : Nat; trivial
  case C => guard_hyp a'' : α; guard_hyp b'' : Nat; guard_hyp c'' : Foo α Nat
            guard_hyp ih : True; trivial

example (x : Bar n) : x = x := by
  induction' x with a b c d h ih
  case A => guard_target = Bar.A a b = Bar.A a b; rfl
  case B => guard_hyp h : Bar (c + 1); guard_hyp ih : h = h
            guard_target = Bar.B c d h = Bar.B c d h; rfl

example (p q : Prop) : (p → ¬ q) → ¬ (p ∧ q) := by
  intro hpnq hpq
  apply hpnq
  cases' hpq with hp hq
  assumption
  exact hpq.2


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.yoneda
import Mathlib.topology.sheaves.presheaf
import Mathlib.topology.category.TopCommRing
import Mathlib.topology.algebra.continuous_functions
import Mathlib.PostPort

universes v u_1 u

namespace Mathlib

/-!
# Presheaves of functions

We construct some simple examples of presheaves of functions on a topological space.
* `presheaf_to_Type X f`, where `f : X → Type`,
  is the presheaf of dependently-typed (not-necessarily continuous) functions
* `presheaf_to_Type X T`, where `T : Type`,
  is the presheaf of (not-necessarily-continuous) functions to a fixed target type `T`
* `presheaf_to_Top X T`, where `T : Top`,
  is the presheaf of continuous functions into a topological space `T`
* `presheaf_To_TopCommRing X R`, where `R : TopCommRing`
  is the presheaf valued in `CommRing` of functions functions into a topological ring `R`
* as an example of the previous construction,
  `presheaf_to_TopCommRing X (TopCommRing.of ℂ)`
  is the presheaf of rings of continuous complex-valued functions on `X`.
-/

namespace Top

/--
The presheaf of dependently typed functions on `X`, with fibres given by a type family `f`.
There is no requirement that the functions are continuous, here.
-/
def presheaf_to_Types (X : Top) (T : ↥X → Type v) : presheaf (Type v) X :=
  category_theory.functor.mk (fun (U : topological_space.opens ↥Xᵒᵖ) => (x : ↥(opposite.unop U)) → T ↑x)
    fun (U V : topological_space.opens ↥Xᵒᵖ) (i : U ⟶ V) (g : (x : ↥(opposite.unop U)) → T ↑x) (x : ↥(opposite.unop V)) =>
      g (coe_fn (category_theory.has_hom.hom.unop i) x)

@[simp] theorem presheaf_to_Types_obj (X : Top) {T : ↥X → Type v} {U : topological_space.opens ↥Xᵒᵖ} : category_theory.functor.obj (presheaf_to_Types X T) U = ((x : ↥(opposite.unop U)) → T ↑x) :=
  rfl

@[simp] theorem presheaf_to_Types_map (X : Top) {T : ↥X → Type v} {U : topological_space.opens ↥Xᵒᵖ} {V : topological_space.opens ↥Xᵒᵖ} {i : U ⟶ V} {f : category_theory.functor.obj (presheaf_to_Types X T) U} : category_theory.functor.map (presheaf_to_Types X T) i f =
  fun (x : ↥(opposite.unop V)) => f (coe_fn (category_theory.has_hom.hom.unop i) x) :=
  rfl

/--
The presheaf of functions on `X` with values in a type `T`.
There is no requirement that the functions are continuous, here.
-/
-- We don't just define this in terms of `presheaf_to_Types`,

-- as it's helpful later to see (at a syntactic level) that `(presheaf_to_Type X T).obj U`

-- is a non-dependent function.

-- We don't use `@[simps]` to generate the projection lemmas here,

-- as it turns out to be useful to have `presheaf_to_Type_map`

-- written as an equality of functions (rather than being applied to some argument).

def presheaf_to_Type (X : Top) (T : Type v) : presheaf (Type v) X :=
  category_theory.functor.mk (fun (U : topological_space.opens ↥Xᵒᵖ) => ↥(opposite.unop U) → T)
    fun (U V : topological_space.opens ↥Xᵒᵖ) (i : U ⟶ V) (g : ↥(opposite.unop U) → T) =>
      g ∘ ⇑(category_theory.has_hom.hom.unop i)

@[simp] theorem presheaf_to_Type_obj (X : Top) {T : Type v} {U : topological_space.opens ↥Xᵒᵖ} : category_theory.functor.obj (presheaf_to_Type X T) U = (↥(opposite.unop U) → T) :=
  rfl

@[simp] theorem presheaf_to_Type_map (X : Top) {T : Type v} {U : topological_space.opens ↥Xᵒᵖ} {V : topological_space.opens ↥Xᵒᵖ} {i : U ⟶ V} {f : category_theory.functor.obj (presheaf_to_Type X T) U} : category_theory.functor.map (presheaf_to_Type X T) i f = f ∘ ⇑(category_theory.has_hom.hom.unop i) :=
  rfl

/-- The presheaf of continuous functions on `X` with values in fixed target topological space `T`. -/
def presheaf_to_Top (X : Top) (T : Top) : presheaf (Type v) X :=
  category_theory.functor.op (topological_space.opens.to_Top X) ⋙ category_theory.functor.obj category_theory.yoneda T

@[simp] theorem presheaf_to_Top_obj (X : Top) (T : Top) (U : topological_space.opens ↥Xᵒᵖ) : category_theory.functor.obj (presheaf_to_Top X T) U =
  (category_theory.functor.obj (topological_space.opens.to_Top X) (opposite.unop U) ⟶ T) :=
  rfl

/-- The (bundled) commutative ring of continuous functions from a topological space
to a topological commutative ring, with pointwise multiplication. -/
-- TODO upgrade the result to TopCommRing?

def continuous_functions (X : Topᵒᵖ) (R : TopCommRing) : CommRing :=
  CommRing.of (opposite.unop X ⟶ category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) R)

namespace continuous_functions

/-- Pulling back functions into a topological ring along a continuous map is a ring homomorphism. -/
def pullback {X : Topᵒᵖ} {Y : Topᵒᵖ} (f : X ⟶ Y) (R : TopCommRing) : continuous_functions X R ⟶ continuous_functions Y R :=
  ring_hom.mk (fun (g : ↥(continuous_functions X R)) => category_theory.has_hom.hom.unop f ≫ g) sorry sorry sorry sorry

/-- A homomorphism of topological rings can be postcomposed with functions from a source space `X`;
this is a ring homomorphism (with respect to the pointwise ring operations on functions). -/
def map (X : Topᵒᵖ) {R : TopCommRing} {S : TopCommRing} (φ : R ⟶ S) : continuous_functions X R ⟶ continuous_functions X S :=
  ring_hom.mk
    (fun (g : ↥(continuous_functions X R)) => g ≫ category_theory.functor.map (category_theory.forget₂ TopCommRing Top) φ)
    sorry sorry sorry sorry

end continuous_functions

/-- An upgraded version of the Yoneda embedding, observing that the continuous maps
from `X : Top` to `R : TopCommRing` form a commutative ring, functorial in both `X` and `R`. -/
def CommRing_yoneda : TopCommRing ⥤ Topᵒᵖ ⥤ CommRing :=
  category_theory.functor.mk
    (fun (R : TopCommRing) =>
      category_theory.functor.mk (fun (X : Topᵒᵖ) => continuous_functions X R)
        fun (X Y : Topᵒᵖ) (f : X ⟶ Y) => continuous_functions.pullback f R)
    fun (R S : TopCommRing) (φ : R ⟶ S) => category_theory.nat_trans.mk fun (X : Topᵒᵖ) => continuous_functions.map X φ

/--
The presheaf (of commutative rings), consisting of functions on an open set `U ⊆ X` with
values in some topological commutative ring `T`.

For example, we could construct the presheaf of continuous complex valued functions of `X` as
```
presheaf_to_TopCommRing X (TopCommRing.of ℂ)
```
(this requires `import topology.instances.complex`).
-/
def presheaf_to_TopCommRing (X : Top) (T : TopCommRing) : presheaf CommRing X :=
  category_theory.functor.op (topological_space.opens.to_Top X) ⋙ category_theory.functor.obj CommRing_yoneda T