import .definitions3 .logic

lemma strengthen_impl_with_dominating_instantiations {σ: env} {P P' Q: prop}:
  (σ ⊨ vc.implies P'.to_vc P.to_vc) → (σ ⊨ (prop.implies P Q).to_vc) → (σ ⊨ (prop.implies P' Q).to_vc) :=
  begin
    assume h1,
    assume h2,
    apply valid_env.to_vc_implies.mpr,
    apply valid_env.mpr,
    assume h3,
    have h4, from valid_env.mp h1 h3,
    have h5, from valid_env.to_vc_implies.mp h2,
    from valid_env.mp h5 h4
  end

lemma strengthen_vc {P P' Q: prop} {σ: env}:
  (σ ⊨ vc.implies P'.to_vc P.to_vc) → (FV P ⊆ FV P') →
  (closed_subst σ (prop.implies P Q) → σ ⊨ (prop.implies P Q).to_vc) →
  (closed_subst σ (prop.implies P' Q) → σ ⊨ (prop.implies P' Q).to_vc) :=
  begin
    assume h1,
    assume h2,
    assume h3,
    assume h4,
    apply @strengthen_impl_with_dominating_instantiations σ P P' Q,
    from h1,

    have h5: closed_subst σ (prop.implies P Q), by begin
      assume x,
      assume h6,
      cases free_in_prop.implies.inv h6 with h7 h8,
      have h9: x ∈ FV P, from h7,
      have h10, from set.mem_of_mem_of_subset h9 h2,
      have h12: free_in_prop x (prop.implies P' Q), from free_in_prop.implies₁ h10,
      from h4 h12,

      have h12: free_in_prop x (prop.implies P' Q), from free_in_prop.implies₂ h8,
      from h4 h12
    end,
    from h3 h5
  end

lemma strengthen_vc_with_q {P P' Q S: prop} {σ: env}:
  (σ ⊨ vc.implies P'.to_vc P.to_vc) → (FV P ⊆ FV P') →
  (closed_subst σ (prop.implies (P ⋀ Q) S) → σ ⊨ (prop.implies (P ⋀ Q) S).to_vc) →
  (closed_subst σ (prop.implies (P' ⋀ Q) S) → σ ⊨ (prop.implies (P' ⋀ Q) S).to_vc) :=
  begin
    assume h1,
    assume h2,
    assume h3,
    assume h4,
    apply @strengthen_impl_with_dominating_instantiations σ (P ⋀ Q) (P' ⋀ Q) S,
    from vc.implies.same_right (λ_, h1),
    have h5: closed_subst σ (prop.implies (P⋀Q) S), by begin
      assume x,
      assume h6,
      cases free_in_prop.implies.inv h6 with h7 h8,
      cases free_in_prop.and.inv h7 with h8 h9,
      have h9: x ∈ FV P, from h8,
      have h10, from set.mem_of_mem_of_subset h9 h2,
      have h11: free_in_prop x (P' ⋀ Q), from free_in_prop.and₁ h10,
      have h12: free_in_prop x (prop.implies (P' ⋀ Q) S), from free_in_prop.implies₁ h11,
      from h4 h12,

      have h11: free_in_prop x (P' ⋀ Q), from free_in_prop.and₂ h9,
      have h12: free_in_prop x (prop.implies (P' ⋀ Q) S), from free_in_prop.implies₁ h11,
      from h4 h12,

      have h12: free_in_prop x (prop.implies (P' ⋀ Q) S), from free_in_prop.implies₂ h8,
      from h4 h12
    end,
    from h3 h5
  end

lemma strengthen_exp {P: prop} {Q: propctx} {e: exp}:
      (P ⊩ e : Q) → ∀P': prop, (FV P' = FV P) → (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc) → (P' ⊩ e: Q) :=
  assume e_verified: (P ⊩ e : Q),
  begin
    induction e_verified,
    case exp.dvcgen.tru x P e' Q x_not_free_in_P e'_verified ih { from (
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have h1: FV (P' ⋀ x ≡ value.true) = FV (P ⋀ x ≡ value.true),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ x ≡ value.true).to_vc (P ⋀ x ≡ value.true).to_vc),
      from λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ),
      have e'_verified': P' ⋀ x ≡ value.true ⊩ e': Q, from ih (P' ⋀ x ≡ value.true) h1 h2,
      have x_not_free_in_P': x ∉ FV P', from free_P'_P.symm ▸ x_not_free_in_P,
      show P' ⊩ lett x = true in e' : propctx.exis x (x ≡ value.true ⋀ Q),
      from exp.dvcgen.tru x_not_free_in_P' e'_verified'
    )},
    case exp.dvcgen.fals x P e' Q x_not_free_in_P e'_verified ih { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have h1: FV (P' ⋀ (x ≡ value.false)) = FV (P ⋀ x ≡ value.false),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ x ≡ value.false).to_vc (P ⋀ x ≡ value.false).to_vc),
      from λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ),
      have e'_verified': P' ⋀ x ≡ value.false ⊩ e': Q, from ih (P' ⋀ x ≡ value.false) h1 h2,
      have x_not_free_in_P': x ∉ FV P', from free_P'_P.symm ▸ x_not_free_in_P,
      show P' ⊩ letf x = false in e' : propctx.exis x ((x ≡ value.false) ⋀ Q),
      from exp.dvcgen.fals x_not_free_in_P' e'_verified'
    },
    case exp.dvcgen.num x n P e' Q x_not_free_in_P e'_verified ih { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have h1: FV (P' ⋀ x ≡ value.num n) = FV (P ⋀ x ≡ value.num n),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ x ≡ value.num n).to_vc (P ⋀ x ≡ value.num n).to_vc),
      from λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ),
      have e'_verified': P' ⋀ (x ≡ value.num n) ⊩ e': Q, from ih (P' ⋀ (x ≡ value.num n)) h1 h2,
      have x_not_free_in_P': x ∉ FV P', from free_P'_P.symm ▸ x_not_free_in_P,
      show P' ⊩ letn x = n in e' : propctx.exis x ((x ≡ value.num n) ⋀ Q),
      from exp.dvcgen.num x_not_free_in_P' e'_verified'
    },
    case exp.dvcgen.func f x R S e₁ e₂ P Q₁ Q₂ f_not_free_in_P x_not_free_in_P f_neq_x x_free_in_R fv_R fv_S
                        e₁_verified e₂_verified func_vc ih₁ ih₂ { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have f_not_free_in_P': f ∉ FV P', from free_P'_P.symm ▸ f_not_free_in_P,
      have x_not_free_in_P': x ∉ FV P', from free_P'_P.symm ▸ x_not_free_in_P,
      have fv_R': FV R.to_prop ⊆ FV P' ∪ { f, x }, from free_P'_P.symm ▸ fv_R,
      have fv_S': FV S.to_prop ⊆ FV P' ∪ { f, x }, from free_P'_P.symm ▸ fv_S,

      have h1: FV (P' ⋀ ((spec.func f x R S) ⋀ R)) = FV (P ⋀ ((spec.func f x R S) ⋀ R)),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ (spec.func f x R S) ⋀ R).to_vc (P ⋀ (spec.func f x R S) ⋀ R).to_vc),
      from λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ),
      have e₁_verified': P' ⋀ (spec.func f x R S) ⋀ R ⊩ e₁ : Q₁,
      from ih₁ (P' ⋀ (spec.func f x R S) ⋀ R) h1 h2,

      have h3: FV (P' ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S)))
             = FV (P ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S))),
      from free_in_prop.same_right free_P'_P,

      have h5: (∀σ, σ ⊨ vc.implies (P' ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S))).to_vc
                      (P ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S))).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),

      have e₂_verified': P' ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S)) ⊩ e₂ : Q₂,
      from ih₂ (P' ⋀ (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S))) h3 h5,

      have func_vc': ∀ (σ : env),
            closed_subst σ (prop.implies (P'⋀↑(spec.func ↑f x R S) ⋀ R ⋀ Q₁ (term.app ↑f ↑x)) ↑S) →
             σ ⊨ (prop.implies (P' ⋀ ↑(spec.func ↑f x R S) ⋀ R ⋀ Q₁ (term.app ↑f ↑x)) ↑S).to_vc,
      from (λσ, strengthen_vc_with_q (P'_dominates_p_P σ) (set.subset_of_eq free_P'_P.symm) (func_vc σ)),

      show P' ⊩ letf f[x] req R ens S {e₁} in e₂ : propctx.exis f (prop.func f x R (Q₁ (term.app ↑f ↑x) ⋀ ↑S) ⋀ Q₂),
      from exp.dvcgen.func f_not_free_in_P' x_not_free_in_P' f_neq_x x_free_in_R fv_R' fv_S' e₁_verified'
           e₂_verified' func_vc'
    },
    case exp.dvcgen.unop op x y P e' Q' x_free_in_P y_not_free_in_P e'_verified vc_valid ih { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have x_free_in_P': x ∈ FV P', from free_P'_P.symm ▸ x_free_in_P,
      have y_not_free_in_P': y ∉ FV P', from free_P'_P.symm ▸ y_not_free_in_P,

      have h1: FV (P' ⋀ y ≡ term.unop op x) = FV (P ⋀ y ≡ term.unop op x),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ y ≡ term.unop op x).to_vc (P ⋀ y ≡ term.unop op x).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),
      have e'_verified': P' ⋀ y ≡ term.unop op x ⊩ e' : Q',
      from ih (P' ⋀ y ≡ term.unop op x) h1 h2,

      have FV P ⊆ FV P', from set.subset_of_eq free_P'_P.symm,
      have vc_valid': ∀ (σ : env),
           closed_subst σ (prop.implies P' (prop.pre₁ op x)) → σ ⊨ (prop.implies P' (prop.pre₁ op x)).to_vc,
      from (λσ, strengthen_vc (P'_dominates_p_P σ) this (vc_valid σ)),

      show P' ⊩ letop y = op [x] in e' : propctx.exis y (y ≡ term.unop op x ⋀ Q'),
      from exp.dvcgen.unop x_free_in_P' y_not_free_in_P' e'_verified' vc_valid'
    },
    case exp.dvcgen.binop op x y z e' P Q' x_free_in_P y_free_in_P z_not_free_in_P e'_verified vc_valid ih { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have x_free_in_P': x ∈ FV P', from free_P'_P.symm ▸ x_free_in_P,
      have y_free_in_P': y ∈ FV P', from free_P'_P.symm ▸ y_free_in_P,
      have z_not_free_in_P': z ∉ FV P', from free_P'_P.symm ▸ z_not_free_in_P,

      have h1: FV (P' ⋀ z ≡ term.binop op x y) = FV (P ⋀ z ≡ term.binop op x y),
      from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ z ≡ term.binop op x y).to_vc (P ⋀ z ≡ term.binop op x y).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),
      have e'_verified': P' ⋀ z ≡ term.binop op x y ⊩ e' : Q',
      from ih (P' ⋀ z ≡ term.binop op x y) h1 h2,

      have FV P ⊆ FV P', from set.subset_of_eq free_P'_P.symm,
      have vc_valid': ∀ (σ : env),
        closed_subst σ (prop.implies P' (prop.pre₂ op x y)) →
        σ ⊨ (prop.implies P' (prop.pre₂ op x y)).to_vc,
      from (λσ, strengthen_vc (P'_dominates_p_P σ) this (vc_valid σ)),

      show P' ⊩ letop2 z = op [x, y] in e' : propctx.exis z (z ≡ term.binop op x y ⋀ Q'),
      from exp.dvcgen.binop x_free_in_P' y_free_in_P' z_not_free_in_P' e'_verified' vc_valid'
    },
    case exp.dvcgen.app y f x e' P Q' f_free_in_P x_free_in_P y_not_free_in_P e'_verified vc_valid ih { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have f_free_in_P': f ∈ FV P', from free_P'_P.symm ▸ f_free_in_P,
      have x_free_in_P': x ∈ FV P', from free_P'_P.symm ▸ x_free_in_P,
      have y_not_free_in_P': y ∉ FV P', from free_P'_P.symm ▸ y_not_free_in_P,

      have h1: FV (P' ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x)
             = FV (P ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x),
      from free_in_prop.same_right free_P'_P,

      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x).to_vc
                                (P ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),

      have e'_verified': P' ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x ⊩ e' : Q',
      from ih (P' ⋀ prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x) h1 h2,

      have vc_valid': ∀ (σ : env),
           closed_subst σ (prop.implies (P' ⋀ prop.call x) (term.unop unop.isFunc f ⋀ prop.pre f x)) →
           σ ⊨ (prop.implies (P' ⋀ prop.call x) (term.unop unop.isFunc f ⋀ prop.pre f x)).to_vc,
      from (λσ, strengthen_vc_with_q (P'_dominates_p_P σ) (set.subset_of_eq free_P'_P.symm) (vc_valid σ)),

      show P' ⊩ letapp y = f [x] in e' : propctx.exis y (prop.call x ⋀ prop.post f x ⋀ y ≡ term.app f x ⋀ Q'),
      from exp.dvcgen.app f_free_in_P' x_free_in_P' y_not_free_in_P' e'_verified' vc_valid'
    },
    case exp.dvcgen.ite x e₂ e₁ P Q₁ Q₂ x_free_in_P e₁_verified e₂_verified vc_valid ih₁ ih₂ { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have x_free_in_P': x ∈ FV P', from free_P'_P.symm ▸ x_free_in_P,

      have h1: FV (P' ⋀ x) = FV (P ⋀ x), from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ x).to_vc (P ⋀ x).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),
      have e₁_verified': P' ⋀ x ⊩ e₁ : Q₁, from ih₁ (P' ⋀ x) h1 h2,

      have h1: FV (P' ⋀ prop.not x) = FV (P ⋀ prop.not x), from free_in_prop.same_right free_P'_P,
      have h2: (∀σ, σ ⊨ vc.implies (P' ⋀ prop.not x).to_vc (P ⋀ prop.not x).to_vc),
      from (λσ, vc.implies.same_right (λ_, P'_dominates_p_P σ)),
      have e₂_verified': P' ⋀ prop.not x ⊩ e₂ : Q₂, from ih₂ (P' ⋀ prop.not x) h1 h2,

      have FV P ⊆ FV P', from set.subset_of_eq free_P'_P.symm,
      have vc_valid': ∀ (σ : env),
           closed_subst σ (prop.implies P' (term.unop unop.isBool x)) →
           σ ⊨ (prop.implies P' (term.unop unop.isBool x)).to_vc,
      from (λσ, strengthen_vc (P'_dominates_p_P σ) this (vc_valid σ)),

      show P' ⊩ exp.ite x e₁ e₂ : propctx.implies x Q₁ ⋀ propctx.implies (prop.not x) Q₂,
      from exp.dvcgen.ite x_free_in_P' e₁_verified' e₂_verified' vc_valid'
    },
    case exp.dvcgen.return x P x_free_in_P { from
      assume P': prop,
      assume free_P'_P: FV P' = FV P,
      assume P'_dominates_p_P: (∀σ, σ ⊨ vc.implies P'.to_vc P.to_vc),

      have x_free_in_P': x ∈ FV P', from free_P'_P.symm ▸ x_free_in_P,

      show P' ⊩ exp.return x : (x ≣ •), from exp.dvcgen.return x_free_in_P'
    }
  end


import ReactorModel.Objects.Reactor.Updatable
import Mathlib.Tactic.Set

noncomputable section
open Classical
open Reactor (Component)

namespace ReactorType

def UniqueIDs [ReactorType α] (rtr : α) : Prop :=
  ∀ {cpt i}, Subsingleton (Member cpt i rtr)

class Indexable (α) extends LawfulUpdatable α where
  unique_ids : ∀ {rtr : α}, UniqueIDs rtr

structure Container (α) where
  id  : WithTop ID
  rtr : α

instance [Coe α β] : Coe (Container α) (Container β) where
  coe i := { id := i.id, rtr := i.rtr }

namespace Member

variable [LawfulUpdatable α]

def container {rtr : α} : (Member cpt i rtr) → Container α
  | .nest _ (.nest h l)             => container (.nest h l)
  | .nest (rtr₂ := con) (j := j) .. => { id := j, rtr := con }
  | .final _                        => { id := ⊤, rtr := rtr }

theorem nest_container  {rtr₁ rtr₂ : α}
    (h : ReactorType.nest rtr₁ i = some rtr₂) (m : Member cpt j rtr₂) :
    ∃ (k : ID) (con : α), (Member.nest h m).container = ⟨k, con⟩ := by
  induction m generalizing i rtr₁
  case final => simp [container]
  case nest hn _ hi => simp [container, hi hn]

theorem container_eq_root {rtr : α} {m : Member cpt i rtr} (h : m.container = ⟨⊤, con⟩) :
    rtr = con := by
  induction m generalizing con
  case final =>
    simp [container] at h
    assumption
  case nest hn m _ =>
    have ⟨_, _, _⟩ := nest_container hn m
    simp_all

end Member

namespace Indexable

variable [a : Indexable α]

def con? (rtr : α) (cpt : Component) : ID ⇀ Container α :=
  fun i => if m : Nonempty (Member cpt i rtr) then m.some.container else none

notation rtr "[" cpt "]&"        => ReactorType.Indexable.con? rtr cpt
notation rtr "[" cpt "][" i "]&" => ReactorType.Indexable.con? rtr cpt i

def obj? (rtr : α) : (cpt : Component) → cpt.idType ⇀ a.cptType cpt
  | .val cpt, i        => rtr[.val cpt][i]& >>= fun con => cpt? (.val cpt) con.rtr i
  | .rcn,     i        => rtr[.rcn][i]&     >>= fun con => cpt? .rcn       con.rtr i
  | .rtr,     (i : ID) => rtr[.rtr][i]&     >>= fun con => cpt? .rtr       con.rtr i
  | .rtr,     ⊤        => rtr

notation (priority := 1001) rtr "[" cpt "]" => ReactorType.Indexable.obj? rtr cpt
notation rtr "[" cpt "][" i "]"             => ReactorType.Indexable.obj? rtr cpt i

variable {rtr rtr₁ rtr₂ : α}

end Indexable
end ReactorType


import category_theory.adjunction.basic
import category_theory.limits.has_limits
import data.pfun

open category_theory category_theory.functor category_theory.limits
universes u v
variables (𝒞 : Type) [category.{0} 𝒞]

inductive bicompletion_aux : bool → Type 1
| of_cat_obj : 𝒞 → bicompletion_aux ff
| limit_obj {D : Type} (F : D → bicompletion_aux tt) : bicompletion_aux ff
| colimit_obj {D : Type} (F : D → bicompletion_aux tt) : bicompletion_aux ff
| of_cat_hom : Π {X Y : 𝒞}, (X ⟶ Y) → bicompletion_aux tt -- of_cat_obj X ⟶ of_cat_obj Y
| limit_cone_comp {D : Type} (F : D → bicompletion_aux tt)
  (X : D) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- F_obj X ⟶ Y
  bicompletion_aux tt -- limit_obj F ⟶ Y
| colimit_cocone_comp {D : Type} (F : D → bicompletion_aux tt)
  (X : D) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- Y ⟶ F_obj X
  bicompletion_aux tt -- Y ⟶ colimit_obj F
| is_limit {D : Type} (F : D → bicompletion_aux tt)
  (cone_obj : bicompletion_aux ff)
  (cone : Π (X : D), bicompletion_aux tt) : -- cone_obj ⟶ F_obj X
  bicompletion_aux tt -- cone_obj → limit_obj F
| is_colimit {D : Type} (F : D → bicompletion_aux tt)
  (cocone_obj : bicompletion_aux ff)
  (cocone : Π (X : D), bicompletion_aux tt) : -- F_obj X ⟶ cocone_obj
  bicompletion_aux tt -- colimit_obj F ⟶ cocone_obj
| id (X : bicompletion_aux ff) : bicompletion_aux tt -- X ⟶ X

namespace bicompletion_aux

variable {𝒞}

@[simp] def dom : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj X
| (@limit_cone_comp _ _ _ F _ _ _) := by exactI limit_obj F
| (@is_limit _ _ _ _ cone_obj _) := cone_obj
| (@colimit_cocone_comp _ _ _ _ X Y f) := Y
| (@is_colimit _ _ _ F cocone_obj cocone) := by exactI colimit_obj F
| (id X) := X

@[simp] def cod : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj Y
| (@colimit_cocone_comp _ _ 𝒟 F X _ _) := by exactI colimit_obj F
| (@is_colimit _ _ 𝒟 F cocone_obj cocone) := cocone_obj
| (@limit_cone_comp _ _ 𝒟 F X Y f) := Y
| (@is_limit _ _ 𝒟 F cone_obj cone) := by exactI limit_obj F
| (id X) := X

open sum

inductive valid : bicompletion_aux 𝒞 ff ⊕ bicompletion_aux 𝒞 tt → Type 1
| of_cat_obj : Π (X : 𝒞), valid (inl (of_cat_obj X))
| limit_obj {D : Type} (F : D → bicompletion_aux 𝒞 tt) (hF : Π (X : D), valid (inr (F X))) :
    valid (inl (limit_obj F))
| colimit_obj {D : Type} (F : D → bicompletion_aux 𝒞 tt) (hF : Π (X : D), valid (inr (F X))) :
    valid (inl (colimit_obj F))
| limit_cone_comp {D : Type} (F : D → bicompletion_aux 𝒞 tt)
  (hF : Π (X : D), valid (inr (F X)))
  (X : D) (Y : bicompletion_aux 𝒞 ff)
  (hY : valid (inl Y))
  (f : bicompletion_aux 𝒞 tt)
  (hf : valid (inr f))
  (hfd : f.dom = (F X).dom)
  (hfc : f.cod = Y)

  : -- F_obj X ⟶ Y
  bicompletion_aux tt -- limit_obj F ⟶ Y

variable (𝒞)

def obj₁ : Type 1 := bicompletion_aux 𝒞 ff

variable {𝒞}
variables {D : Type} [category.{0} 𝒟]

def hom₁ (X Y : obj₁ 𝒞) : Type 1 :=
{ f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }

@[simp] lemma coe_dom {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).dom = X := f.2.1

@[simp] lemma coe_cod {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).cod = Y := f.2.2

def of_cat_obj₁ (X : 𝒞) : obj₁ 𝒞 := of_cat_obj X

def limit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
limit_obj _

def colimit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
colimit_obj F_obj (λ X Y f, (F_hom f).1)

def of_cat_hom₁ {X Y : 𝒞} (f : X ⟶ Y) : hom₁ (of_cat_obj X) (of_cat_obj Y) :=
⟨of_cat_hom f, by simp⟩

def limit_cone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y) :
  hom₁ (limit_obj₁ F_obj @F_hom) Y :=
⟨limit_cone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [limit_obj₁]⟩

def colimit_cocone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X)) :
  hom₁ Y (colimit_obj₁ F_obj @F_hom) :=
⟨colimit_cocone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [colimit_obj₁]⟩

def is_limit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X)) :
  hom₁ cone_obj (limit_obj₁ F_obj @F_hom) :=
⟨is_limit F_obj (λ X Y f, (F_hom f).1) cone_obj (λ X, (cone X).1), by simp [limit_obj₁]⟩

def is_colimit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj) :
  hom₁ (colimit_obj₁ F_obj @F_hom) cocone_obj  :=
⟨is_colimit F_obj (λ X Y f, (F_hom f).1) cocone_obj (λ X, (cocone X).1), by simp [colimit_obj₁]⟩

def id₁ (X : obj₁ 𝒞) : hom₁ X X := ⟨id X, rfl, rfl⟩

@[elab_as_eliminator] def bicompletion_tt_rec_on
  {motive : bicompletion_aux 𝒞 tt → Sort u}
  (f : bicompletion_aux 𝒞 tt)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom f))
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt)
    (ih : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)),
      motive f → by exactI motive (limit_cone_comp F_obj @F_hom X Y f))
  (colimit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt)
    (ih : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)),
      motive f → by exactI motive (colimit_cocone_comp F_obj @F_hom X Y f))
  (is_limit : Π {𝒟 : Type} [_inst_2 : category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt)
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
    by exactI motive (is_limit F_obj @F_hom cone_obj cone))
  (is_colimit : Π {𝒟 : Type} [_inst_2 : category 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt)
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
    by exactI motive (is_colimit F_obj @F_hom cone_obj cone))
  (id : Π (X : bicompletion_aux 𝒞 ff), motive X.id) :
  motive f := sorry

def comp₁ (f : bicompletion_aux 𝒞 tt) : bicompletion_aux 𝒞 tt → part (bicompletion_aux 𝒞 tt) :=
bicompletion_tt_rec_on f
  begin
    intros X Y f g,
    refine bicompletion_tt_rec_on g _ _ _ _ _ _,
    { intros B C g,
      exact ⟨Y = B, λ h, by subst h; exact of_cat_hom (f ≫ g)⟩ },
    { intros, exact part.none },
    { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂,
      exact ih₂ >>= λ ih₂, return (colimit_cocone_comp F_obj @F_hom A B ih₂) },
    { introsI 𝒟 _ F_obj F_hom A cone ih₁ ih₂,
      exact ⟨∀ (X : 𝒟), (ih₂ X).dom, λ h, is_limit F_obj @F_hom (of_cat_obj X) (λ X, (ih₂ X).get (h X))⟩ },
    { intros, exact part.none },
    { intros, exact return (of_cat_hom f) }
  end
  begin
    introsI 𝒟 _ F_obj F_hom A B f _ ih₂ g,
    exact ih₂ g >>= λ ih₂, return (limit_cone_comp F_obj @F_hom A B ih₂)
  end
  begin
    introsI 𝒟 _ F_obj F_hom A B f ih₁ ih₂ g,
    revert ih₂ A,
    refine bicompletion_tt_rec_on g _ _ _ _ _ _,
    { intros, exact part.none },
    { intros, exact part.none },
    { introsI ℰ _ G_obj G_hom C Y g ih₃ ih₄ ih₂ A,
      exact ih₄ ih₂ A >>= λ ih₄, return (colimit_cocone_comp G_obj @G_hom C Y ih₄) },
    { introsI ℰ _ G_obj G_hom _ g ih₃ ih₄ ih₂ A,
      exact ⟨Π (X : ℰ), (ih₄ X ih₂ A).dom,
        λ h, is_limit G_obj @G_hom B (λ X, (ih₄ X ih₂ A).get (h X))⟩ },
    { introsI ℰ _ G_obj G_hom cocone_obj cocone _ g ih₂ A,
      exact ih₂ (cocone A) },
    { intros A f _,
      exact colimit_cocone_comp₂ F_obj @F_hom A f }
  end
  _ _ (λ _, return)
  -- begin
  --   introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ Z g,
  --   revert ih₂,
  --   refine hom₂_limit_obj_rec_on g _ _ _ _,
  --   { introsI ℰ _ G_obj G_hom A B g ih₂,
  --     exact ih₂ A g },
  --   { introsI ℰ _ F_obj F_hom A ℱ _ G_obj G_hom g ih₃ ih₂,
  --     exact colimit_cocone_comp₂ F_obj @F_hom A (ih₃ @ih₂) },
  --   { introsI ℰ _ F_obj F_hom ℱ _ G_obj G_hom ih₃ ih₄ ih₂,
  --     exact is_limit₂ F_obj @F_hom cone_obj (λ X, ih₄ _ @ih₂) },
  --   { introsI ih,
  --     exact is_limit₂ F_obj @F_hom cone_obj cone }
  -- end
  -- begin
  --   introsI 𝒟 _ F_obj F_hom ih₁ cocone_obj cocone ih₂ Z g,
  --   exact is_colimit₂ F_obj @F_hom Z (λ A, ih₂ A g)
  -- end
  -- (λ _ _ g, g)

inductive valid_obj₁ : Π (X : obj₁ 𝒞), Prop
| of_cat_obj (X : 𝒞) : valid_obj₁ (of_cat_obj X)
| limit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (limit_obj₁ F_obj @F_hom)
| colimit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (colimit_obj₁ F_obj @F_hom)

def valid_obj₁_limit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (limit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : limit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [limit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption },
  { simp [*, colimit_obj₁] at * }
end

def valid_obj₁_colimit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (colimit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : colimit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [*, limit_obj₁] at * },
  { simp [colimit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption }
end

@[elab_as_eliminator] def hom_rec_on {motive : bicompletion_aux 𝒞 tt → Sort u}
  (f : bicompletion_aux 𝒞 tt)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom f))
  (limit_cone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI limit_cone_comp F_obj @F_hom X Y f))
  (is_limit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    (Π (X : 𝒟), motive (cone X)) → motive (by exactI is_limit F_obj @F_hom cone_obj cone))
  (colimit_cocone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI colimit_cocone_comp F_obj @F_hom X Y f))
  (is_colimit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
   (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cocone_obj : bicompletion_aux 𝒞 ff)
   (cocone : 𝒟 → bicompletion_aux 𝒞 tt),
     (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
     (Π (X : 𝒟), motive (cocone X)) → motive (by exactI is_colimit F_obj @F_hom cocone_obj cocone))
  (id : Π (X : obj₁ 𝒞), motive (id X)) :
  motive f :=
have ∀ b (f : bicompletion_aux 𝒞 b) (h : b = tt), motive (eq.rec_on h f) :=
  begin
    intros b f,
    refine bicompletion_aux.rec_on f _ _ _ _ _ _ _ _ _,
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros X Y f _,
      exact of_cat_hom f },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact limit_cone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact colimit_cocone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_limit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_colimit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
    { intros X _ _, exact id X }
  end,
this tt f rfl

inductive valid_hom₁ : Π {X Y : obj₁ 𝒞}, hom₁ X Y → Prop
| of_cat_hom {X Y : 𝒞} (f : X ⟶ Y) : valid_hom₁ (of_cat_hom₁ f)
| id (X : obj₁ 𝒞) : valid_hom₁ (id₁ X)
| limit_cone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (limit_cone_comp₁ F_obj @F_hom X f)
| colimit_cocone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (colimit_cocone_comp₁ F_obj @F_hom X f)
| is_limit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cone_valid : Π (X : 𝒟), valid_hom₁ (cone X)) :
  valid_hom₁ (is_limit₁ F_obj @F_hom cone_obj cone)
| is_colimit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cocone_valid : Π (X : 𝒟), valid_hom₁ (cocone X)) :
  valid_hom₁ (is_colimit₁ F_obj @F_hom cocone_obj cocone)

variable (𝒞)

def obj₂ : Type 1 := { X : obj₁ 𝒞 // valid_obj₁ X }

variable {𝒞}

def hom₂ (X Y : obj₂ 𝒞) : Type 1 := { f : hom₁ X.1 Y.1 // valid_hom₁ f }

open valid_hom₁

def of_cat_obj₂ (X : 𝒞) : obj₂ 𝒞 :=
⟨of_cat_obj X, valid_obj₁.of_cat_obj _⟩

lemma of_cat_obj₂_injective : function.injective (@of_cat_obj₂ 𝒞 _) :=
begin
  intros X Y hXY,
  simp [of_cat_obj₂] at hXY,
  injection hXY,
end

def limit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨limit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.limit_obj _ _ (λ X, (F_obj X).2)⟩

lemma limit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : limit_obj₂ F_obj₁ @F_hom₁ = limit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [limit_obj₂, limit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def colimit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨colimit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.colimit_obj _ _ (λ X, (F_obj X).2)⟩

lemma colimit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : colimit_obj₂ F_obj₁ @F_hom₁ = colimit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [colimit_obj₂, colimit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def of_cat_hom₂ {X Y : 𝒞} (f : X ⟶ Y) : hom₂ (of_cat_obj₂ X) (of_cat_obj₂ Y) :=
⟨of_cat_hom₁ f, valid_hom₁.of_cat_hom _⟩

def limit_cone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y) :
  hom₂ (limit_obj₂ F_obj @F_hom) Y :=
⟨limit_cone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.limit_cone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def colimit_cocone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X)):
  hom₂ Y (colimit_obj₂ F_obj @F_hom) :=
⟨colimit_cocone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.colimit_cocone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def is_limit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cone_obj : obj₂ 𝒞)
  (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X)) :
  hom₂ cone_obj (limit_obj₂ F_obj @F_hom) :=
⟨is_limit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cone_obj.1 (λ X, (cone X).1),
  valid_hom₁.is_limit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cone X).2)⟩

def is_colimit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cocone_obj : obj₂ 𝒞)
  (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj) :
  hom₂ (colimit_obj₂ F_obj @F_hom) cocone_obj  :=
⟨is_colimit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cocone_obj.1 (λ X, (cocone X).1),
  valid_hom₁.is_colimit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cocone X).2)⟩

def id₂ (X : obj₂ 𝒞) : hom₂ X X := ⟨id₁ X.1, valid_hom₁.id _⟩

@[elab_as_eliminator] protected def hom₂.rec_on
  {motive : Π {X Y : obj₂ 𝒞} (f : hom₂ X Y), Sort*} {X Y : obj₂ 𝒞} (f : hom₂ X Y)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y)
    (ih_f : motive f),
      motive (by exactI limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cone_obj : obj₂ 𝒞) (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom cone_obj cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj)
    (ih_cone : Π (X : 𝒟), motive (cocone X)),
      motive (by exactI is_colimit₂ F_obj @F_hom cocone_obj cocone))
  (id : Π (X : obj₂ 𝒞), motive (id₂ X)):
  motive f :=
begin
  cases X with X hX, cases Y with Y hY,
  cases f with f hf,
  rcases f with ⟨f, hfd, hfc⟩,
  revert X Y hX hY,
  refine hom_rec_on f _ _ _ _ _ _,
  { intros A B f X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    exact of_cat_hom f },
  { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
     let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    have valid_g :
      ∃ (h₁ : g.dom = F_obj A) (h₂ : g.cod = B),
      valid_hom₁ ⟨g, h₁, h₂⟩,
    { cases hf, simpa },
    let g' : hom₂ (F_obj' A) ⟨B, hY⟩ :=
      ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
    exact limit_cone_comp F_obj' F_hom'
      (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd) A g'
          (ih₂ (F_obj' A).1 B (F_obj' A).2 hY g'.1.2.1 g'.1.2.2 g'.2) },
  { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc,
    substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    let cone_obj' : obj₂ 𝒞 := ⟨cone_obj, hX⟩,
    have valid_cone : ∀ (X : 𝒟), ∃ (h₁ : (cone X).dom = cone_obj'.1)
      (h₂ : (cone X).cod = (F_obj' X).1),
      valid_hom₁ ⟨cone X, h₁, h₂⟩,
    { cases hf, simpa },
    let cone' : Π (X : 𝒟), hom₂ cone_obj' (F_obj' X) :=
      λ X, ⟨⟨cone X, (valid_cone X).fst, (valid_cone X).snd.fst⟩, (valid_cone X).snd.snd⟩,
    exact is_limit F_obj' F_hom'
      (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
        (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
        (valid_F_hom _ _ f).snd.snd)
        cone_obj' cone'
        (λ X, ih₂ X cone_obj'.1 (F_obj' X).1 cone_obj'.2 (F_obj' X).2
            (cone' X).1.2.1 (cone' X).1.2.2 (cone' X).2) },
  { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    have valid_g :
      ∃ (h₁ : g.dom = B) (h₂ : g.cod = F_obj A),
      valid_hom₁ ⟨g, h₁, h₂⟩,
    { cases hf, simpa },
    let g' : hom₂ ⟨B, hX⟩ (F_obj' A) :=
      ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    exact colimit_cocone_comp F_obj' F_hom'
      (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd) A g'
          (ih₂ B (F_obj' A).1 hX (F_obj' A).2 g'.1.2.1 g'.1.2.2 g'.2) },
  { introsI 𝒟 _ F_obj F_hom cocone_obj cocone ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc,
    substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
    let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    let cocone_obj' : obj₂ 𝒞 := ⟨cocone_obj, hY⟩,
    have valid_cocone : ∀ (X : 𝒟), ∃ (h₁ : (cocone X).dom = (F_obj' X).1)
      (h₂ : (cocone X).cod = cocone_obj'.1),
      valid_hom₁ ⟨cocone X, h₁, h₂⟩,
    { cases hf, simpa },
    let cocone' : Π (X : 𝒟), hom₂ (F_obj' X) cocone_obj' :=
      λ X, ⟨⟨cocone X, (valid_cocone X).fst, (valid_cocone X).snd.fst⟩, (valid_cocone X).snd.snd⟩,
    exact is_colimit F_obj' F_hom'
      (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
        (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
        (valid_F_hom _ _ f).snd.snd)
        cocone_obj' cocone'
        (λ X, ih₂ X (F_obj' X).1 cocone_obj'.1 (F_obj' X).2 cocone_obj'.2
            (cocone' X).1.2.1 (cocone' X).1.2.2 (cocone' X).2) },
  { intros A B C hB _ hAB hBC _,
    dsimp at hAB hBC, subst A, subst C,
    exact id ⟨B, hB⟩ }
end

def hom₂_of_cat_obj_rec_on
  {motive : Π {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y), Sort*}
  {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y)
  (of_cat_hom : Π {Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : 𝒞} (f : hom₂ (of_cat_obj₂ Y) (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cone_obj : 𝒞) (cone : Π (X : 𝒟), hom₂ (of_cat_obj₂ cone_obj) (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom (of_cat_obj₂ cone_obj) cone))
  (id : motive (id₂ (of_cat_obj₂ X))):
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = of_cat_obj₂ X),
  motive (show hom₂ (of_cat_obj₂ X) B, from eq.rec_on h f))
  (of_cat_obj₂ X) Y f
  (λ A B g h, begin
      have := of_cat_obj₂_injective h,
      subst this,
      dsimp,
      exact of_cat_hom g
    end)
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂] at h,
    contradiction
  end
  begin
    intros X h,
    subst h,
    exact id
  end
  rfl

def hom₂_limit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI limit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (limit_obj₂ F_obj @F_hom) Y)
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y),
      by exactI motive (limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (f : hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (cone : Π (X : 𝒟), hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (is_limit₂ F_obj @F_hom (limit_obj₂ G_obj @G_hom) cone))
  (id : by exactI motive (id₂ (limit_obj₂ F_obj @F_hom))) :
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = limit_obj₂ F_obj @F_hom),
  motive (show hom₂ (limit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (limit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ A B g ih₂ h,
    unfreezingI { rcases (limit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact limit_cone_comp _ _ _ _
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, limit_obj₂] at h,
    contradiction
  end
  begin
    introsI X h,
    subst h,
    exact id
  end
  rfl

@[elab_as_eliminator] def hom₂_colimit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI colimit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (colimit_obj₂ F_obj @F_hom) Y)
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (f : hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (cone : Π (X : 𝒟), hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (by exactI is_limit₂ F_obj @F_hom _ cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj),
      by exactI motive (is_colimit₂ F_obj @F_hom cocone_obj cocone))
  (id : by exactI motive (id₂ (colimit_obj₂ F_obj @F_hom))):
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = colimit_obj₂ F_obj @F_hom),
  motive (show hom₂ (colimit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (colimit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁] at h,
    contradiction
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁, limit_obj₁, limit_obj₂] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ (λ X, ih₂ X rfl)
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ cocone_obj cocone ih₂ h,
    unfreezingI { rcases (colimit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact is_colimit _ _ _ _
  end
  begin
    introsI X h,
    subst h,
    exact id
  end
  rfl

def comp₂ {X Y : obj₂ 𝒞} (f : hom₂ X Y) : Π {Z : obj₂ 𝒞}, hom₂ Y Z → hom₂ X Z :=
hom₂.rec_on f
  begin
    intros X Y f Z g,
    refine hom₂_of_cat_obj_rec_on g _ _ _ _,
    { intros B g,
      exact of_cat_hom₂ (f ≫ g) },
    { introsI 𝒟 _ F_obj F_hom A B g ih,
      exact colimit_cocone_comp₂ F_obj @F_hom A ih },
    { introsI 𝒟 _ F_obj F_hom A cone ih,
      exact is_limit₂ F_obj @F_hom (of_cat_obj₂ X) (λ X, ih _) },
    { exact of_cat_hom₂ f }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    refine limit_cone_comp₂ F_obj @F_hom A (ih₂ g),
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    revert ih₂ A,
    refine hom₂_colimit_obj_rec_on g _ _ _ _,
    { introsI ℰ _ G_obj G_hom C ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      refine colimit_cocone_comp₂ G_obj @G_hom C (ih₄ A g @ih₂) },
    { introsI ℰ _ G_obj G_hom ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      exact is_limit₂ G_obj @G_hom B (λ X, ih₄ X A g @ih₂) },
    { introsI ℰ _ G_obj G_hom cocone_obj cocone A g ih₂,
      exact ih₂ (cocone A) },
    { intros A f _,
      exact colimit_cocone_comp₂ F_obj @F_hom A f }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ Z g,
    revert ih₂,
    refine hom₂_limit_obj_rec_on g _ _ _ _,
    { introsI ℰ _ G_obj G_hom A B g ih₂,
      exact ih₂ A g },
    { introsI ℰ _ F_obj F_hom A ℱ _ G_obj G_hom g ih₃ ih₂,
      exact colimit_cocone_comp₂ F_obj @F_hom A (ih₃ @ih₂) },
    { introsI ℰ _ F_obj F_hom ℱ _ G_obj G_hom ih₃ ih₄ ih₂,
      exact is_limit₂ F_obj @F_hom cone_obj (λ X, ih₄ _ @ih₂) },
    { introsI ih,
      exact is_limit₂ F_obj @F_hom cone_obj cone }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cocone_obj cocone ih₂ Z g,
    exact is_colimit₂ F_obj @F_hom Z (λ A, ih₂ A g)
  end
  (λ _ _ g, g)
#print has_limits_of_size
variables {ℰ : Type u} [category ℰ] [has_limits_of_size.{0} ℰ] [has_colimits_of_size.{0} ℰ] (F : 𝒞 ⥤ ℰ)

def UMP_obj {X Y : obj₂ 𝒞} (f : hom₂ X Y) : Σ A B : ℰ, A ⟶ B :=
hom₂.rec_on f
  (λ X Y f, ⟨F.obj X, F.obj Y, F.map f⟩)
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂,

  end
  _
  _
  _
  _

end bicompletion_aux


import category_theory.functor_category
--import field_theory.splitting_field
--import field_theory.subfield
import algebra.field
import algebra.ring
--import ring_theory.algebra
--import ring_theory.algebraic
import category_theory.isomorphism
import algebra.group.hom
import data.set.basic

open category_theory
universes v u
--variables (k : Type u) [𝕜 :field k] (L : Type u) [𝕃 :field L] (F : Type u) [𝔽 :field F]
structure fields : Type (u+1) :=
(k : Type u)
(fStruct : field k)

instance fields_to_sort : has_coe_to_sort fields :=
{S := Type u, coe := λ F, F.k}
instance fieldIsField (a : fields) : field a := a.fStruct

instance fields_has_hom : has_hom fields :=
{ hom:= λ a b, ring_hom a b }
instance fields_has_cat_struct : category_struct fields :=
{to_has_hom:= fields_has_hom, id:=λ X, ring_hom.id X, comp := λ a b c fab fbc,ring_hom.comp fbc fab }

structure fieldsOver (L : fields.{u}) : Type (u+1)  :=
(k : fields.{u})
(L2k : L →+* k )

instance ext_fields_coe (L : fields.{u}) : has_coe (fieldsOver L) fields.{u}:=
⟨fieldsOver.k⟩

@[ext] structure kLinearMor {L : fields.{u}} (k₁ k₂ : fieldsOver L) : Type u :=
(mor : k₁ →+* k₂ )
(coincide : ring_hom.comp mor k₁.L2k = k₂.L2k )

instance morphism_to_fun {L : fields.{u}} (k₁ k₂ : fieldsOver L) :
  has_coe_to_fun ( kLinearMor k₁ k₂) :=
{ F   := λ _, k₁ → k₂,
  coe := λ m, m.mor }

instance ext_fields_has_hom (L : fields.{u}) : has_hom (fieldsOver L) :=
{hom := kLinearMor }

instance ext_fields_has_cat_struct (L : fields.{u}) : category_struct (fieldsOver L) :=
{to_has_hom:= ext_fields_has_hom L, id:=λ X, {mor :=  ring_hom.id X, coincide:= ring_hom.id_comp _ },
 comp := λ a b c fab fbc,⟨ring_hom.comp fbc.mor fab.mor, by rw [ring_hom.comp_assoc,fab.coincide,fbc.coincide] ⟩ }

/- variables (L : fields.{u})(X Y Z :fieldsOver L)
#check (ext_fields_has_cat_struct L).comp
#check kLinearMor.mor (𝟙X)
 -/
instance ext_fields_cat (L : fields.{u}): category (fieldsOver L):=
{
  to_category_struct := ext_fields_has_cat_struct L,

  id_comp' :=begin  intros X Y fXY ,ext,
  dsimp [kLinearMor.mor],
   refl, end  ,

  comp_id':=begin  intros X Y fXY ,ext,
  dsimp [kLinearMor.mor],
   refl, end  ,

  assoc' := begin intros W X Y Z f g h ,ext,
  dsimp [kLinearMor.mor],
   refl, end
  }

/- structure subFields (F : Type u) [𝔽 :field F] : Type (u+1):=
(k : Type u)
(𝕜 :field k)
(k2F : k →+* F ) -/

 def AutGrp (L : fields.{u})(F : fieldsOver L):Type u :=
 --F ≃ₐ[L] F
 F ≅ F

--notation `Aut(`:30 F `/` L  := AutGrp L F

instance aut_grp_struct (L : fields.{u})(F : fieldsOver L) : group (AutGrp L F) :=
{ mul:= λ a b, iso.trans b a,
  mul_assoc := begin intros a b c, ext, simp, end,
  one := iso.refl F,
  one_mul := begin intro a, ext,simp,refl,  end,
  mul_one := begin intro a, ext,simp, refl, end,
  inv := iso.symm,
  mul_left_inv := category_theory.iso.self_symm_id
}
/- { mul:= alg_equiv.trans,
  mul_assoc := begin intros a b c, ext, simp, refl, end,
  one := alg_equiv.refl,
  one_mul := begin intro a, ext,simp, refl, end,
  mul_one := begin intro a, ext,simp, refl, end,
  inv := alg_equiv.symm,
  mul_left_inv := begin intro a,ext,simp,rw a.left_inv, end

} -/

structure fieldsBetween (L : fields.{u})(F : fieldsOver L)   :Type (u+1)  :=
(k:fieldsOver L)
(k2F : k ⟶ F)
instance bet_fields_coe (L : fields.{u})(F : fieldsOver L) : has_coe (fieldsBetween L F) (fieldsOver L) :=
⟨fieldsBetween.k⟩

variables (L : fields.{u})(F : fieldsOver L)(E : fieldsOver F.k)

instance inbeding_coe : has_coe (fieldsOver F.k) (fieldsOver L ):=
⟨ λ E, {k:= E.k, L2k:= ring_hom.comp E.L2k F.L2k }⟩

lemma induce1 : (↑E: fieldsOver L).L2k = ring_hom.comp E.L2k F.L2k :=
begin ext,refl, end

def base_change_functor : functor (fieldsOver F.k) (fieldsOver L) :=
{
  obj := λ E , ↑E,
  map := λ A B f , ⟨f.mor, begin cases f,dsimp,rw [induce1,induce1, ←ring_hom.comp_assoc ,f_coincide], end ⟩,
  map_id':= begin intro X, ext, refl, end,
  map_comp':= begin intros X Y Z f g, ext,refl, end
}

instance AutSubGrp_lift : has_lift (AutGrp F.k E) (AutGrp L ↑E) :=
⟨functor.map_iso (base_change_functor L F)⟩

lemma lift_inj(g: AutGrp F.k E) : ⇑(g.hom.mor)=(↑ g : (AutGrp L ↑E)).hom.mor :=
begin ext, refl, end

def AutSubGrp : monoid_hom (AutGrp F.k E) (AutGrp L ↑E) :=
{ to_fun :=λ g, ↑g,
  map_one' := by refl,
  map_mul' := begin intros x y, ext, refl, end,
}

lemma AutSub_inj : function.injective ⇑(AutSubGrp L F E) :=
begin
rw monoid_hom.injective_iff,
intros a h,
apply iso.ext,
have h0 : ⇑(AutSubGrp L F E)  = λa, ↑a := by refl,
rw h0 at h, dsimp at h,
have h1:= (lift_inj _ _ _ a),
rw h at h1, symmetry,
ext, rw h1,refl,
end

def normal_ext(F: fieldsOver L) :  Prop :=
∀ (K : fieldsOver L) (f g : F ⟶ K) , set.range f = set.range g


import for_mathlib.short_complex_functor_category

noncomputable theory

open category_theory category_theory.category category_theory.limits

namespace category_theory

namespace functor

variables {C₁ C₂ C₃ : Type*} [category C₁] [category C₂] [category C₃] [has_zero_morphisms C₃]
  [has_zero_object C₃]

lemma is_zero_of_comp (F : C₁ ⥤ C₂) (G : C₂ ⥤ C₃) (h : limits.is_zero G) :
  limits.is_zero (F ⋙ G) :=
begin
  rw limits.is_zero.iff_id_eq_zero,
  ext,
  apply limits.is_zero.eq_zero_of_src,
  dsimp,
  apply limits.is_zero.obj,
  exact h,
end

end functor

end category_theory

namespace homological_complex

variables (C : Type*) [category C] [has_zero_morphisms C]
  {M : Type*} (c : complex_shape M)

@[simps]
def prev_functor (i : M) : homological_complex C c ⥤ C :=
homological_complex.eval _ c (c.prev i)

@[simps]
def next_functor (i : M) : homological_complex C c ⥤ C :=
homological_complex.eval _ c (c.next i)

def prev_functor_iso_eval (i j : M) (hij : c.rel j i) :
  prev_functor C c i ≅ homological_complex.eval C c j :=
nat_iso.of_components
  (λ X, X.X_prev_iso hij)
  (λ X Y f, by { dsimp, rw [← iso.eq_comp_inv, assoc, ← hom.prev_eq f hij], })

def next_functor_iso_eval (i j : M) (hij : c.rel i j) :
  next_functor C c i ≅ homological_complex.eval C c j :=
nat_iso.of_components
  (λ X, X.X_next_iso hij)
  (λ X Y f, by { dsimp, rw [← iso.eq_comp_inv, assoc, ← hom.next_eq f hij], })

end homological_complex

namespace short_complex

variables (C : Type*) [category C] [has_zero_morphisms C] {M : Type*} (c : complex_shape M)

def functor_homological_complex_π₁_iso_prev_functor (i : M) :
  functor_homological_complex C c i ⋙ π₁ ≅ homological_complex.prev_functor C c i := by refl

def functor_homological_complex_π₂_iso_eval (i : M) :
  functor_homological_complex C c i ⋙ π₂ ≅ homological_complex.eval C c i := by refl

def functor_homological_complex_π₃_iso_next_functor (i : M) :
  functor_homological_complex C c i ⋙ π₃ ≅ homological_complex.next_functor C c i := by refl

end short_complex


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Sébastien Gouëzel, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.topology.dense_embedding
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4

namespace Mathlib

/-!
# Uniform embeddings of uniform spaces.

Extension of uniform continuous functions.
-/

structure uniform_inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    (f : α → β)
    where
  comap_uniformity :
    filter.comap (fun (x : α × α) => (f (prod.fst x), f (prod.snd x))) (uniformity β) = uniformity α

theorem uniform_inducing.mk' {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {f : α → β}
    (h :
      ∀ (s : set (α × α)),
        s ∈ uniformity α ↔
          ∃ (t : set (β × β)), ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s) :
    uniform_inducing f :=
  sorry

theorem uniform_inducing.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {g : β → γ} (hg : uniform_inducing g) {f : α → β}
    (hf : uniform_inducing f) : uniform_inducing (g ∘ f) :=
  sorry

structure uniform_embedding {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    (f : α → β)
    extends uniform_inducing f where
  inj : function.injective f

theorem uniform_embedding_subtype_val {α : Type u_1} [uniform_space α] {p : α → Prop} :
    uniform_embedding subtype.val :=
  uniform_embedding.mk (uniform_inducing.mk rfl) subtype.val_injective

theorem uniform_embedding_subtype_coe {α : Type u_1} [uniform_space α] {p : α → Prop} :
    uniform_embedding coe :=
  uniform_embedding_subtype_val

theorem uniform_embedding_set_inclusion {α : Type u_1} [uniform_space α] {s : set α} {t : set α}
    (hst : s ⊆ t) : uniform_embedding (set.inclusion hst) :=
  sorry

theorem uniform_embedding.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {g : β → γ} (hg : uniform_embedding g) {f : α → β}
    (hf : uniform_embedding f) : uniform_embedding (g ∘ f) :=
  sorry

theorem uniform_embedding_def {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {f : α → β} :
    uniform_embedding f ↔
        function.injective f ∧
          ∀ (s : set (α × α)),
            s ∈ uniformity α ↔
              ∃ (t : set (β × β)),
                ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s :=
  sorry

theorem uniform_embedding_def' {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {f : α → β} :
    uniform_embedding f ↔
        function.injective f ∧
          uniform_continuous f ∧
            ∀ (s : set (α × α)),
              s ∈ uniformity α →
                ∃ (t : set (β × β)),
                  ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s :=
  sorry

theorem uniform_inducing.uniform_continuous {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {f : α → β} (hf : uniform_inducing f) : uniform_continuous f :=
  sorry

theorem uniform_inducing.uniform_continuous_iff {α : Type u_1} {β : Type u_2} {γ : Type u_3}
    [uniform_space α] [uniform_space β] [uniform_space γ] {f : α → β} {g : β → γ}
    (hg : uniform_inducing g) : uniform_continuous f ↔ uniform_continuous (g ∘ f) :=
  sorry

theorem uniform_inducing.inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {f : α → β} (h : uniform_inducing f) : inducing f :=
  sorry

theorem uniform_inducing.prod {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {α' : Type u_3} {β' : Type u_4} [uniform_space α'] [uniform_space β'] {e₁ : α → α'}
    {e₂ : β → β'} (h₁ : uniform_inducing e₁) (h₂ : uniform_inducing e₂) :
    uniform_inducing fun (p : α × β) => (e₁ (prod.fst p), e₂ (prod.snd p)) :=
  sorry

theorem uniform_inducing.dense_inducing {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {f : α → β} (h : uniform_inducing f) (hd : dense_range f) :
    dense_inducing f :=
  dense_inducing.mk (inducing.mk (inducing.induced (uniform_inducing.inducing h))) hd

theorem uniform_embedding.embedding {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {f : α → β} (h : uniform_embedding f) : embedding f :=
  embedding.mk
    (inducing.mk
      (inducing.induced (uniform_inducing.inducing (uniform_embedding.to_uniform_inducing h))))
    (uniform_embedding.inj h)

theorem uniform_embedding.dense_embedding {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {f : α → β} (h : uniform_embedding f) (hd : dense_range f) :
    dense_embedding f :=
  dense_embedding.mk
    (dense_inducing.mk
      (inducing.mk (inducing.induced (embedding.to_inducing (uniform_embedding.embedding h)))) hd)
    (uniform_embedding.inj h)

theorem closure_image_mem_nhds_of_uniform_inducing {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {s : set (α × α)} {e : α → β} (b : β) (he₁ : uniform_inducing e)
    (he₂ : dense_inducing e) (hs : s ∈ uniformity α) :
    ∃ (a : α), closure (e '' set_of fun (a' : α) => (a, a') ∈ s) ∈ nhds b :=
  sorry

theorem uniform_embedding_subtype_emb {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] (p : α → Prop) {e : α → β} (ue : uniform_embedding e)
    (de : dense_embedding e) : uniform_embedding (dense_embedding.subtype_emb p e) :=
  sorry

theorem uniform_embedding.prod {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {α' : Type u_3} {β' : Type u_4} [uniform_space α'] [uniform_space β'] {e₁ : α → α'}
    {e₂ : β → β'} (h₁ : uniform_embedding e₁) (h₂ : uniform_embedding e₂) :
    uniform_embedding fun (p : α × β) => (e₁ (prod.fst p), e₂ (prod.snd p)) :=
  sorry

theorem is_complete_of_complete_image {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {m : α → β} {s : set α} (hm : uniform_inducing m)
    (hs : is_complete (m '' s)) : is_complete s :=
  sorry

/-- A set is complete iff its image under a uniform embedding is complete. -/
theorem is_complete_image_iff {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {m : α → β} {s : set α} (hm : uniform_embedding m) : is_complete (m '' s) ↔ is_complete s :=
  sorry

theorem complete_space_iff_is_complete_range {α : Type u_1} {β : Type u_2} [uniform_space α]
    [uniform_space β] {f : α → β} (hf : uniform_embedding f) :
    complete_space α ↔ is_complete (set.range f) :=
  sorry

theorem complete_space_congr {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {e : α ≃ β} (he : uniform_embedding ⇑e) : complete_space α ↔ complete_space β :=
  sorry

theorem complete_space_coe_iff_is_complete {α : Type u_1} [uniform_space α] {s : set α} :
    complete_space ↥s ↔ is_complete s :=
  iff.trans (complete_space_iff_is_complete_range uniform_embedding_subtype_coe)
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (is_complete (set.range coe) ↔ is_complete s)) subtype.range_coe))
      (iff.refl (is_complete s)))

theorem is_complete.complete_space_coe {α : Type u_1} [uniform_space α] {s : set α}
    (hs : is_complete s) : complete_space ↥s :=
  iff.mpr complete_space_coe_iff_is_complete hs

theorem is_closed.complete_space_coe {α : Type u_1} [uniform_space α] [complete_space α] {s : set α}
    (hs : is_closed s) : complete_space ↥s :=
  is_complete.complete_space_coe (is_closed.is_complete hs)

theorem complete_space_extension {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {m : β → α} (hm : uniform_inducing m) (dense : dense_range m)
    (h : ∀ (f : filter β), cauchy f → ∃ (x : α), filter.map m f ≤ nhds x) : complete_space α :=
  sorry

theorem totally_bounded_preimage {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β]
    {f : α → β} {s : set β} (hf : uniform_embedding f) (hs : totally_bounded s) :
    totally_bounded (f ⁻¹' s) :=
  sorry

theorem uniform_embedding_comap {α : Type u_1} {β : Type u_2} {f : α → β} [u : uniform_space β]
    (hf : function.injective f) : uniform_embedding f :=
  uniform_embedding.mk (uniform_inducing.mk rfl) hf

theorem uniformly_extend_exists {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e)
    (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [complete_space γ] (a : α) :
    ∃ (c : γ), filter.tendsto f (filter.comap e (nhds a)) (nhds c) :=
  sorry

theorem uniform_extend_subtype {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] [complete_space γ] {p : α → Prop} {e : α → β} {f : α → γ}
    {b : β} {s : set α} (hf : uniform_continuous fun (x : Subtype p) => f (subtype.val x))
    (he : uniform_embedding e) (hd : ∀ (x : β), x ∈ closure (set.range e))
    (hb : closure (e '' s) ∈ nhds b) (hs : is_closed s) (hp : ∀ (x : α), x ∈ s → p x) :
    ∃ (c : γ), filter.tendsto f (filter.comap e (nhds b)) (nhds c) :=
  sorry

theorem uniformly_extend_of_ind {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e)
    (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ] (b : β) :
    dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f (e b) = f b :=
  dense_inducing.extend_eq_at (uniform_inducing.dense_inducing h_e h_dense) b
    (continuous.continuous_at (uniform_continuous.continuous h_f))

theorem uniformly_extend_unique {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e)
    (h_dense : dense_range e) {f : β → γ} [separated_space γ] {g : α → γ}
    (hg : ∀ (b : β), g (e b) = f b) (hc : continuous g) :
    dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f = g :=
  dense_inducing.extend_unique (uniform_inducing.dense_inducing h_e h_dense) hg hc

theorem uniformly_extend_spec {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α]
    [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e)
    (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ]
    [complete_space γ] (a : α) :
    filter.tendsto f (filter.comap e (nhds a))
        (nhds (dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f a)) :=
  sorry

theorem uniform_continuous_uniformly_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3}
    [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e)
    (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ]
    [cγ : complete_space γ] :
    uniform_continuous (dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f) :=
  sorry

end Mathlib


import tactic data.set
import prop.language prop.semantics prop.syntax

namespace prop

theorem completeness (v φ) : v ⊨ φ → ⊢ₗ φ :=
begin
  intro hm,
  sorry
end

end prop


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Stanislas Polu, Jesse Michael Han

Helper functions to work with the tactic monad.
-/
import tactic
import tactic.core
import utils.io
import system.io
import basic.control

namespace expr

meta def app_symbol_is (e : expr) (nm : name) : bool :=
match e.get_app_fn with
| (expr.const n _) := n = nm
| _ := ff
end

meta def contains_undefined (e : expr) : bool :=
e.fold ff $ λ e' _ b, if e'.app_symbol_is `undefined then tt else b

end expr

namespace tactic

meta def set_goal_to (goal : expr) : tactic unit :=
mk_meta_var goal >>= set_goals ∘ pure

meta def guard_sorry (e : expr) : tactic unit := guard $ bnot e.contains_sorry

meta def guard_undefined (e : expr) : tactic unit := guard $ bnot e.contains_undefined

end tactic

section validate

meta def kernel_type_check (pf : expr) : tactic unit := do {
  tp ← tactic.infer_type pf,
  env ← tactic.get_env,
  let decl := (declaration.defn `_ (expr.collect_univ_params pf) tp pf reducibility_hints.opaque ff),
  res ← tactic.capture' (env.add decl $> ()),
  match res with
  | (interaction_monad.result.success _ _) := pure ()
  | (interaction_monad.result.exception msg _ _) := let msg := msg.get_or_else (λ _, ("" : format)) in
    tactic.fail format! "kernel type check failed:\n---\n{msg ()}\n---\n"
  end
}

meta def validate_proof (tgt: expr) (pf: expr) : tactic unit := do {
    env ← tactic.get_env,
    pf ← pure $ env.unfold_untrusted_macros pf,
    pft ← tactic.infer_type pf,
    tactic.type_check pf tactic.transparency.all,
    guard (bnot pf.has_meta_var) <|> do {
      tactic.fail format! "proof contains metavariables"
    },
    tactic.guard_sorry pf <|> do {
      tactic.fail format! "proof contains `sorry`"
    },
    tactic.guard_undefined pf <|> do {
      tactic.fail format! "proof contains `undefined`"
    },
    tactic.is_def_eq tgt pft <|> do {
      tgt_fmt ← tactic.pp tgt,
      pft_fmt ← tactic.pp pft,
      tactic.fail format! "proof type mismatch: {tgt_fmt} != {pft_fmt}"
    },
    kernel_type_check pf
}

meta def validate_decl (nm : name) : tactic unit := do {
  env ← tactic.get_env,
  d ← env.get nm,
  validate_proof d.type d.value
}

end validate

section add_open_namespace

meta def add_open_namespace : name → tactic unit := λ nm, do
env ← tactic.get_env, tactic.set_env (env.execute_open nm)

meta def add_open_namespaces (nms : list name) : tactic unit :=
nms.mmap' add_open_namespace

end add_open_namespace

section hashing

meta def tactic_hash : tactic ℕ := do {
  gs ← tactic.get_goals,
  hs ← gs.mmap $ λ g, do {
    tactic.set_goals [g],
    es ← (::) <$> tactic.target <*> tactic.local_context,
    es.mfoldl (λ acc e, (+) acc <$> expr.hash <$> tactic.head_zeta e) 0
  },
  pure $ hs.sum
}

end hashing

section misc

meta def tactic.is_theorem (nm : name) : tactic bool := do {
  env ← tactic.get_env,
  declaration.is_theorem <$> env.get nm
}

end misc

meta def run_with_input' {α} : lean.parser α → string → tactic α := λ p s,
do
  (p, "") ← lean.parser.run (lean.parser.with_input p s),
  pure p

meta def parse_texpr_with_univs (univs : list string): lean.parser pexpr := do
  -- add all universe names in the list as universe levels
  univs.mmap $ (λ s, lean.parser.add_local_level s),
  -- parse the buffer as a pexpr
  interactive.types.texpr

meta def parse_and_typecheck (proof : string) : tactic expr := do
  let univs := ["u_1001", "u_1002", "u_1003", "u_1004", "u_1005", "u_1006"],
  pexpr_proof_term <- run_with_input' (parse_texpr_with_univs univs) proof,
  proof_term <- tactic.to_expr pexpr_proof_term,
  kernel_type_check proof_term,
  thm <- tactic.infer_type proof_term,
  isproof <- tactic.is_proof proof_term,
  if isproof then return thm else failure


import Aesop

axiom Ring : Type
axiom Scheme : Type
axiom affine (X : Scheme) : Prop
axiom quasi_compact (X : Scheme) : Prop

@[aesop 99%] axiom Spec : Ring → Scheme
@[aesop 99%] axiom qc_of_af {X : Scheme} (h : affine X) : quasi_compact X
@[aesop 99%] axiom ZZ : Ring
@[aesop 99%] axiom spec_affine (R : Ring) : affine (Spec R)

theorem thm : ∃ (X : Scheme) (h₁ : affine X) (h₂ : quasi_compact X), True := by {
  aesop;
}

#print thm

-- example : ∃ (X : Scheme) (h₁ : P X) (h₂ : Q X), True := by {
--   apply Exists.intro (Spec ZZ);
--   apply Exists.intro (spec_affine ZZ);
--   apply Exists.intro (qc_of_af (spec_affine ZZ));
--   apply True.intro;
-- }


import ..evaluation
import utils
import ..tactic_state
import meta.expr
import all
import linear_algebra.tensor_algebra

meta def json.load (path : string) : tactic json := do {
  msg ← tactic.unsafe_run_io $ do {
    f ← io.mk_file_handle path io.mode.read,
    buffer.to_string <$> io.fs.read_to_end f
  },
  tactic.trace format!"[json.load] MESSAGE: {msg}",
  json.parse msg
}

section hom_ext'
meta def tactic.interactive.trace_tactic_state_data (f : string) : tactic unit :=
  do { msg ← (format.to_string ∘ format.flatten ∘ has_to_format.to_format) <$>
         (tactic_state_data.get >>= has_to_tactic_json.to_tactic_json),
       dest_handle ← tactic.unsafe_run_io $ io.mk_file_handle f io.mode.write,
       tactic.unsafe_run_io $ io.fs.put_str_ln dest_handle msg
  }

meta def test_tactic_state (msg₀ : option json) (tac : tactic unit) : tactic unit := do {
  (some msg) ← (do
    if msg₀.is_some then do {msg ← msg₀, pure (some msg) } else
      some <$> json.load "TEST_JSON.json" ),

  tactic.trace format!"MSG LENGTH {(json.unparse msg).length}",
  tactic.trace "REBUILDING TSD",
  tsd ← (has_from_json.from_json : json → tactic tactic_state_data) msg,
  tactic.trace "REBUILT TSD",
  rebuild_tactic_state tsd,
  env ← tactic.get_env,
  ts ← tactic.read,
  ctx ← tactic.local_context,
  tactic.trace format!"LOCAL CONTEXT: {ctx.map expr.to_raw_fmt}",
  result ← run_tac_with_tactic_state (tac *> pure ()) ts,
  tactic.trace "EVALUATION RESULT: " *> tactic.trace result,
  tactic.trace "OK"
}

set_option formatter.hide_full_terms false
set_option pp.implicit true
-- theorem t2 {p q r : Prop} (h₁ : p) (h₂ : q) : (p ∧ q) ∨ r :=
-- begin
--   apply or.inl,
--   trace_tactic_state_data "TEST_JSON.json",
--   -- do { tsd_msg ← tactic_state_data.get >>= has_to_tactic_json.to_tactic_json, test_tactic_state tsd_msg `[apply and.intro] },
--   do { msg ← (format.to_string ∘ format.flatten ∘ has_to_format.to_format) <$>
--          (tactic_state_data.get >>= has_to_tactic_json.to_tactic_json),
--        dest_handle ← tactic.unsafe_run_io $ io.mk_file_handle "TEST_JSON.json" io.mode.write,
--        tactic.unsafe_run_io $ io.fs.put_str_ln dest_handle msg
--   },
--   recover, sorry
--   -- apply and.intro, from ‹_›, from ‹_›
-- end

namespace tensor_algebra
variables (R : Type*) [comm_semiring R]
variables (M : Type*) [add_comm_monoid M] [semimodule R M]

-- @[ext]
-- theorem hom_ext' {A : Type*} [semiring A] [algebra R A] {f g : tensor_algebra R M →ₐ[R] A}
--   (w : f.to_linear_map.comp (ι R) = g.to_linear_map.comp (ι R)) : f = g :=
-- begin
--   rw [←lift_symm_apply, ←lift_symm_apply] at w,
--   do { msg ← (format.to_string ∘ format.flatten ∘ has_to_format.to_format) <$>
--          (tactic_state_data.get >>= has_to_tactic_json.to_tactic_json),
--        dest_handle ← tactic.unsafe_run_io $ io.mk_file_handle "TEST_JSON.json" io.mode.write,
--        tactic.unsafe_run_io $ io.fs.put_str_ln dest_handle msg
--   },
--   exact (lift R).symm.injective w,
-- end
-- #check has_from_json_name_aux

-- run_cmd do {msg ← json.load "TEST_JSON.json", tactic.trace msg, tactic.trace "HELLO", pure ()}

-- run_cmd test_tactic_state none `[apply and.intro] -- we have liftoff

setup_tactic_parser
-- #check lean.parser_state
-- run_cmd do {
--   ps ← lean.parser.mk_parser_state,
--   tactic.trace ps.cur_pos,
--   -- result ← (lean.parser.run' (texpr) " and.intro "),
--   result ← (lean.parser.run' (lean.parser.itactic) " { pure () }"),
--   -- let x := result.val,
--   -- x,
--   tactic.trace "HELLO"
-- }

end tensor_algebra
end hom_ext'


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

universes u_1 u_2

namespace Mathlib

namespace int

/- cast (injection into groups with one) -/

@[simp] theorem nat_cast_eq_coe_nat (n : ℕ) : ↑n = ↑n := sorry

/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/
def of_nat_hom : ℕ →+* ℤ := ring_hom.mk coe sorry of_nat_mul sorry of_nat_add

/-- Canonical homomorphism from the integers to any ring(-like) structure `α` -/
protected def cast {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : ℤ → α := sorry

-- see Note [coercion into rings]

protected instance cast_coe {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : has_coe_t ℤ α :=
  has_coe_t.mk int.cast

@[simp] theorem cast_zero {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] : ↑0 = 0 := rfl

theorem cast_of_nat {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : ℕ) :
    ↑(Int.ofNat n) = ↑n :=
  rfl

@[simp] theorem cast_coe_nat {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : ℕ) :
    ↑↑n = ↑n :=
  rfl

theorem cast_coe_nat' {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : ℕ) : ↑↑n = ↑n :=
  sorry

@[simp] theorem cast_neg_succ_of_nat {α : Type u_1} [HasZero α] [HasOne α] [Add α] [Neg α] (n : ℕ) :
    ↑(Int.negSucc n) = -(↑n + 1) :=
  rfl

@[simp] theorem cast_one {α : Type u_1} [add_monoid α] [HasOne α] [Neg α] : ↑1 = 1 := nat.cast_one

@[simp] theorem cast_sub_nat_nat {α : Type u_1} [add_group α] [HasOne α] (m : ℕ) (n : ℕ) :
    ↑(sub_nat_nat m n) = ↑m - ↑n :=
  sorry

@[simp] theorem cast_neg_of_nat {α : Type u_1} [add_group α] [HasOne α] (n : ℕ) :
    ↑(neg_of_nat n) = -↑n :=
  nat.cases_on n (idRhs (0 = -0) (Eq.symm neg_zero))
    fun (n : ℕ) => idRhs (↑(neg_of_nat (n + 1)) = ↑(neg_of_nat (n + 1))) rfl

@[simp] theorem cast_add {α : Type u_1} [add_group α] [HasOne α] (m : ℤ) (n : ℤ) :
    ↑(m + n) = ↑m + ↑n :=
  sorry

@[simp] theorem cast_neg {α : Type u_1} [add_group α] [HasOne α] (n : ℤ) : ↑(-n) = -↑n :=
  int.cases_on n (fun (n : ℕ) => idRhs (↑(neg_of_nat n) = -↑n) (cast_neg_of_nat n))
    fun (n : ℕ) =>
      idRhs (↑(-Int.negSucc n) = --↑(-Int.negSucc n)) (Eq.symm (neg_neg ↑(-Int.negSucc n)))

@[simp] theorem cast_sub {α : Type u_1} [add_group α] [HasOne α] (m : ℤ) (n : ℤ) :
    ↑(m - n) = ↑m - ↑n :=
  sorry

@[simp] theorem cast_mul {α : Type u_1} [ring α] (m : ℤ) (n : ℤ) : ↑(m * n) = ↑m * ↑n := sorry

/-- `coe : ℤ → α` as an `add_monoid_hom`. -/
def cast_add_hom (α : Type u_1) [add_group α] [HasOne α] : ℤ →+ α :=
  add_monoid_hom.mk coe sorry cast_add

@[simp] theorem coe_cast_add_hom {α : Type u_1} [add_group α] [HasOne α] :
    ⇑(cast_add_hom α) = coe :=
  rfl

/-- `coe : ℤ → α` as a `ring_hom`. -/
def cast_ring_hom (α : Type u_1) [ring α] : ℤ →+* α := ring_hom.mk coe sorry cast_mul sorry sorry

@[simp] theorem coe_cast_ring_hom {α : Type u_1} [ring α] : ⇑(cast_ring_hom α) = coe := rfl

theorem cast_commute {α : Type u_1} [ring α] (m : ℤ) (x : α) : commute (↑m) x :=
  int.cases_on m (fun (n : ℕ) => nat.cast_commute n x)
    fun (n : ℕ) => commute.neg_left (nat.cast_commute (n + 1) x)

theorem commute_cast {α : Type u_1} [ring α] (x : α) (m : ℤ) : commute x ↑m :=
  commute.symm (cast_commute m x)

@[simp] theorem coe_nat_bit0 (n : ℕ) : ↑(bit0 n) = bit0 ↑n := sorry

@[simp] theorem coe_nat_bit1 (n : ℕ) : ↑(bit1 n) = bit1 ↑n := sorry

@[simp] theorem cast_bit0 {α : Type u_1} [ring α] (n : ℤ) : ↑(bit0 n) = bit0 ↑n := cast_add n n

@[simp] theorem cast_bit1 {α : Type u_1} [ring α] (n : ℤ) : ↑(bit1 n) = bit1 ↑n := sorry

theorem cast_two {α : Type u_1} [ring α] : ↑(bit0 1) = bit0 1 := sorry

theorem cast_mono {α : Type u_1} [ordered_ring α] : monotone coe := sorry

@[simp] theorem cast_nonneg {α : Type u_1} [ordered_ring α] [nontrivial α] {n : ℤ} :
    0 ≤ ↑n ↔ 0 ≤ n :=
  sorry

@[simp] theorem cast_le {α : Type u_1} [ordered_ring α] [nontrivial α] {m : ℤ} {n : ℤ} :
    ↑m ≤ ↑n ↔ m ≤ n :=
  sorry

theorem cast_strict_mono {α : Type u_1} [ordered_ring α] [nontrivial α] : strict_mono coe :=
  strict_mono_of_le_iff_le fun (m n : ℤ) => iff.symm cast_le

@[simp] theorem cast_lt {α : Type u_1} [ordered_ring α] [nontrivial α] {m : ℤ} {n : ℤ} :
    ↑m < ↑n ↔ m < n :=
  strict_mono.lt_iff_lt cast_strict_mono

@[simp] theorem cast_nonpos {α : Type u_1} [ordered_ring α] [nontrivial α] {n : ℤ} :
    ↑n ≤ 0 ↔ n ≤ 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n ≤ 0 ↔ n ≤ 0)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n ≤ ↑0 ↔ n ≤ 0)) (propext cast_le))) (iff.refl (n ≤ 0)))

@[simp] theorem cast_pos {α : Type u_1} [ordered_ring α] [nontrivial α] {n : ℤ} : 0 < ↑n ↔ 0 < n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < ↑n ↔ 0 < n)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑0 < ↑n ↔ 0 < n)) (propext cast_lt))) (iff.refl (0 < n)))

@[simp] theorem cast_lt_zero {α : Type u_1} [ordered_ring α] [nontrivial α] {n : ℤ} :
    ↑n < 0 ↔ n < 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n < 0 ↔ n < 0)) (Eq.symm cast_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n < ↑0 ↔ n < 0)) (propext cast_lt))) (iff.refl (n < 0)))

@[simp] theorem cast_min {α : Type u_1} [linear_ordered_ring α] {a : ℤ} {b : ℤ} :
    ↑(min a b) = min ↑a ↑b :=
  monotone.map_min cast_mono

@[simp] theorem cast_max {α : Type u_1} [linear_ordered_ring α] {a : ℤ} {b : ℤ} :
    ↑(max a b) = max ↑a ↑b :=
  monotone.map_max cast_mono

@[simp] theorem cast_abs {α : Type u_1} [linear_ordered_ring α] {q : ℤ} : ↑(abs q) = abs ↑q := sorry

theorem coe_int_dvd {α : Type u_1} [comm_ring α] (m : ℤ) (n : ℤ) (h : m ∣ n) : ↑m ∣ ↑n :=
  ring_hom.map_dvd (cast_ring_hom α) h

end int

namespace add_monoid_hom

/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal
if `f 1 = g 1`. -/
theorem ext_int {A : Type u_1} [add_monoid A] {f : ℤ →+ A} {g : ℤ →+ A}
    (h1 : coe_fn f 1 = coe_fn g 1) : f = g :=
  sorry

theorem eq_int_cast_hom {A : Type u_1} [add_group A] [HasOne A] (f : ℤ →+ A) (h1 : coe_fn f 1 = 1) :
    f = int.cast_add_hom A :=
  sorry

theorem eq_int_cast {A : Type u_1} [add_group A] [HasOne A] (f : ℤ →+ A) (h1 : coe_fn f 1 = 1)
    (n : ℤ) : coe_fn f n = ↑n :=
  iff.mp ext_iff (eq_int_cast_hom f h1)

end add_monoid_hom

namespace monoid_hom

theorem ext_int {M : Type u_1} [monoid M] {f : multiplicative ℤ →* M} {g : multiplicative ℤ →* M}
    (h1 : coe_fn f (coe_fn multiplicative.of_add 1) = coe_fn g (coe_fn multiplicative.of_add 1)) :
    f = g :=
  ext fun (x : multiplicative ℤ) => iff.mp add_monoid_hom.ext_iff (add_monoid_hom.ext_int h1) x

end monoid_hom

namespace ring_hom

@[simp] theorem eq_int_cast {α : Type u_1} [ring α] (f : ℤ →+* α) (n : ℤ) : coe_fn f n = ↑n :=
  add_monoid_hom.eq_int_cast (to_add_monoid_hom f) (map_one f) n

theorem eq_int_cast' {α : Type u_1} [ring α] (f : ℤ →+* α) : f = int.cast_ring_hom α :=
  ext (eq_int_cast f)

@[simp] theorem map_int_cast {α : Type u_1} {β : Type u_2} [ring α] [ring β] (f : α →+* β) (n : ℤ) :
    coe_fn f ↑n = ↑n :=
  eq_int_cast (comp f (int.cast_ring_hom α)) n

theorem ext_int {R : Type u_1} [semiring R] (f : ℤ →+* R) (g : ℤ →+* R) : f = g :=
  coe_add_monoid_hom_injective (add_monoid_hom.ext_int (Eq.trans (map_one f) (Eq.symm (map_one g))))

protected instance int.subsingleton_ring_hom {R : Type u_1} [semiring R] : subsingleton (ℤ →+* R) :=
  subsingleton.intro ext_int

end ring_hom

@[simp] theorem int.cast_id (n : ℤ) : ↑n = n := Eq.symm (ring_hom.eq_int_cast (ring_hom.id ℤ) n)

end Mathlib