/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module algebra.category.Mon.basic
! leanprover-community/mathlib commit 0caf3701139ef2e69c215717665361cda205a90b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.ConcreteCategory.BundledHom
import Mathbin.Algebra.PunitInstances
import Mathbin.CategoryTheory.Functor.ReflectsIsomorphisms

/-!
# Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid.

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

We introduce the bundled categories:
* `Mon`
* `AddMon`
* `CommMon`
* `AddCommMon`
along with the relevant forgetful functors between them.
-/

universe u v

open CategoryTheory

#print MonCat /-
/-- The category of monoids and monoid morphisms. -/
@[to_additive AddMonCat]
def MonCat : Type (u + 1) :=
  Bundled Monoid
#align Mon MonCat
#align AddMon AddMonCat
-/

/-- The category of additive monoids and monoid morphisms. -/
add_decl_doc AddMonCat

namespace MonCat

#print MonCat.AssocMonoidHom /-
/-- `monoid_hom` doesn't actually assume associativity. This alias is needed to make the category
theory machinery work. -/
@[to_additive
      "`add_monoid_hom` doesn't actually assume associativity. This alias is needed to make\nthe category theory machinery work."]
abbrev AssocMonoidHom (M N : Type _) [Monoid M] [Monoid N] :=
  MonoidHom M N
#align Mon.assoc_monoid_hom MonCat.AssocMonoidHom
#align AddMon.assoc_add_monoid_hom AddMonCat.AssocAddMonoidHom
-/

#print MonCat.bundledHom /-
@[to_additive]
instance bundledHom : BundledHom AssocMonoidHom :=
  ⟨fun M N [Monoid M] [Monoid N] => @MonoidHom.toFun M N _ _, fun M [Monoid M] => @MonoidHom.id M _,
    fun M N P [Monoid M] [Monoid N] [Monoid P] => @MonoidHom.comp M N P _ _ _,
    fun M N [Monoid M] [Monoid N] => @MonoidHom.coe_inj M N _ _⟩
#align Mon.bundled_hom MonCat.bundledHom
#align AddMon.bundled_hom AddMonCat.bundledHom
-/

deriving instance LargeCategory, ConcreteCategory for MonCat

attribute [to_additive] MonCat.largeCategory MonCat.concreteCategory

@[to_additive]
instance : CoeSort MonCat (Type _) :=
  Bundled.hasCoeToSort

#print MonCat.of /-
/-- Construct a bundled `Mon` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [Monoid M] : MonCat :=
  Bundled.of M
#align Mon.of MonCat.of
#align AddMon.of AddMonCat.of
-/

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

#print MonCat.ofHom /-
/-- Typecheck a `monoid_hom` as a morphism in `Mon`. -/
@[to_additive]
def ofHom {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : of X ⟶ of Y :=
  f
#align Mon.of_hom MonCat.ofHom
#align AddMon.of_hom AddMonCat.ofHom
-/

/-- Typecheck a `add_monoid_hom` as a morphism in `AddMon`. -/
add_decl_doc AddMonCat.ofHom

/- warning: Mon.of_hom_apply -> MonCat.ofHom_apply is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y] (f : MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) (x : X), Eq.{succ u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2)) (coeFn.{succ u1, succ u1} (Quiver.Hom.{succ u1, succ u1} MonCat.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} MonCat.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1})) (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2)) (fun (_x : MonoidHom.{u1, u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} X _inst_1)) (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2)) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} X _inst_1)) (CategoryTheory.Bundled.str.{u1, u1} Monoid.{u1} (MonCat.of.{u1} X _inst_1))) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2)) (CategoryTheory.Bundled.str.{u1, u1} Monoid.{u1} (MonCat.of.{u1} Y _inst_2)))) => (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} X _inst_1)) -> (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2))) (MonoidHom.hasCoeToFun.{u1, u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} X _inst_1)) (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2)) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} X _inst_1)) (CategoryTheory.Bundled.str.{u1, u1} Monoid.{u1} (MonCat.of.{u1} X _inst_1))) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} (CategoryTheory.Bundled.{u1, u1} Monoid.{u1}) Type.{u1} (CategoryTheory.Bundled.hasCoeToSort.{u1, u1} Monoid.{u1}) (MonCat.of.{u1} Y _inst_2)) (CategoryTheory.Bundled.str.{u1, u1} Monoid.{u1} (MonCat.of.{u1} Y _inst_2)))) (MonCat.ofHom.{u1} X Y _inst_1 _inst_2 f) x) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) (fun (_x : MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) => X -> Y) (MonoidHom.hasCoeToFun.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) f x)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y] (f : MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) (x : X), Eq.{succ u1} (Prefunctor.obj.{succ u1, succ u1, succ u1, succ u1} MonCat.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} MonCat.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1})) Type.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} Type.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1})) (CategoryTheory.Functor.toPrefunctor.{u1, u1, succ u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.forget.{succ u1, u1, u1} MonCat.{u1} MonCat.largeCategory.{u1} MonCat.concreteCategory.{u1})) (MonCat.of.{u1} Y _inst_2)) (Prefunctor.map.{succ u1, succ u1, succ u1, succ u1} MonCat.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} MonCat.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1})) Type.{u1} (CategoryTheory.CategoryStruct.toQuiver.{u1, succ u1} Type.{u1} (CategoryTheory.Category.toCategoryStruct.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1})) (CategoryTheory.Functor.toPrefunctor.{u1, u1, succ u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} Type.{u1} CategoryTheory.types.{u1} (CategoryTheory.forget.{succ u1, u1, u1} MonCat.{u1} MonCat.largeCategory.{u1} MonCat.concreteCategory.{u1})) (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2) (MonCat.ofHom.{u1} X Y _inst_1 _inst_2 f) x) (FunLike.coe.{succ u1, succ u1, succ u1} (MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) X (fun (_x : X) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : X) => Y) _x) (MulHomClass.toFunLike.{u1, u1, u1} (MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) X Y (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X _inst_1)) (MulOneClass.toMul.{u1} Y (Monoid.toMulOneClass.{u1} Y _inst_2)) (MonoidHomClass.toMulHomClass.{u1, u1, u1} (MonoidHom.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)) X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2) (MonoidHom.monoidHomClass.{u1, u1} X Y (Monoid.toMulOneClass.{u1} X _inst_1) (Monoid.toMulOneClass.{u1} Y _inst_2)))) f x)
Case conversion may be inaccurate. Consider using '#align Mon.of_hom_apply MonCat.ofHom_applyₓ'. -/
@[simp]
theorem ofHom_apply {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) (x : X) : ofHom f x = f x :=
  rfl
#align Mon.of_hom_apply MonCat.ofHom_apply

@[to_additive]
instance : Inhabited MonCat :=
  ⟨-- The default instance for `monoid punit` is derived via `punit.comm_ring`,
        -- which breaks to_additive.
        @of
        PUnit <|
      @Group.toMonoid _ <| @CommGroup.toGroup _ PUnit.commGroup⟩

@[to_additive]
instance (M : MonCat) : Monoid M :=
  M.str

#print MonCat.coe_of /-
@[simp, to_additive]
theorem coe_of (R : Type u) [Monoid R] : (MonCat.of R : Type u) = R :=
  rfl
#align Mon.coe_of MonCat.coe_of
#align AddMon.coe_of AddMonCat.coe_of
-/

@[to_additive]
instance {G : Type _} [Group G] : Group (MonCat.of G) := by assumption

end MonCat

#print CommMonCat /-
/-- The category of commutative monoids and monoid morphisms. -/
@[to_additive AddCommMonCat]
def CommMonCat : Type (u + 1) :=
  Bundled CommMonoid
#align CommMon CommMonCat
#align AddCommMon AddCommMonCat
-/

/-- The category of additive commutative monoids and monoid morphisms. -/
add_decl_doc AddCommMonCat

namespace CommMonCat

@[to_additive]
instance : BundledHom.ParentProjection CommMonoid.toMonoid :=
  ⟨⟩

deriving instance LargeCategory, ConcreteCategory for CommMonCat

attribute [to_additive] CommMonCat.largeCategory CommMonCat.concreteCategory

@[to_additive]
instance : CoeSort CommMonCat (Type _) :=
  Bundled.hasCoeToSort

#print CommMonCat.of /-
/-- Construct a bundled `CommMon` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [CommMonoid M] : CommMonCat :=
  Bundled.of M
#align CommMon.of CommMonCat.of
#align AddCommMon.of AddCommMonCat.of
-/

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

@[to_additive]
instance : Inhabited CommMonCat :=
  ⟨-- The default instance for `comm_monoid punit` is derived via `punit.comm_ring`,
        -- which breaks to_additive.
        @of
        PUnit <|
      @CommGroup.toCommMonoid _ PUnit.commGroup⟩

@[to_additive]
instance (M : CommMonCat) : CommMonoid M :=
  M.str

#print CommMonCat.coe_of /-
@[simp, to_additive]
theorem coe_of (R : Type u) [CommMonoid R] : (CommMonCat.of R : Type u) = R :=
  rfl
#align CommMon.coe_of CommMonCat.coe_of
#align AddCommMon.coe_of AddCommMonCat.coe_of
-/

#print CommMonCat.hasForgetToMonCat /-
@[to_additive has_forget_to_AddMon]
instance hasForgetToMonCat : HasForget₂ CommMonCat MonCat :=
  BundledHom.forget₂ _ _
#align CommMon.has_forget_to_Mon CommMonCat.hasForgetToMonCat
#align AddCommMon.has_forget_to_AddMon AddCommMonCat.hasForgetToAddMonCat
-/

@[to_additive]
instance : Coe CommMonCat.{u} MonCat.{u} where coe := (forget₂ CommMonCat MonCat).obj

end CommMonCat

-- We verify that the coercions of morphisms to functions work correctly:
example {R S : MonCat} (f : R ⟶ S) : (R : Type) → (S : Type) :=
  f

example {R S : CommMonCat} (f : R ⟶ S) : (R : Type) → (S : Type) :=
  f

-- We verify that when constructing a morphism in `CommMon`,
-- when we construct the `to_fun` field, the types are presented as `↥R`,
-- rather than `R.α` or (as we used to have) `↥(bundled.map comm_monoid.to_monoid R)`.
example (R : CommMonCat.{u}) : R ⟶ R :=
  { toFun := fun x => by
      match_target(R : Type u)
      match_hyp x : (R : Type u)
      exact x * x
    map_one' := by simp
    map_mul' := fun x y => by
      rw [mul_assoc x y (x * y), ← mul_assoc y x y, mul_comm y x, mul_assoc, mul_assoc] }

variable {X Y : Type u}

section

variable [Monoid X] [Monoid Y]

/- warning: mul_equiv.to_Mon_iso -> MulEquiv.toMonCatIso is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y], (MulEquiv.{u1, u1} X Y (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X _inst_1)) (MulOneClass.toHasMul.{u1} Y (Monoid.toMulOneClass.{u1} Y _inst_2))) -> (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y], (MulEquiv.{u1, u1} X Y (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X _inst_1)) (MulOneClass.toMul.{u1} Y (Monoid.toMulOneClass.{u1} Y _inst_2))) -> (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2))
Case conversion may be inaccurate. Consider using '#align mul_equiv.to_Mon_iso MulEquiv.toMonCatIsoₓ'. -/
/-- Build an isomorphism in the category `Mon` from a `mul_equiv` between `monoid`s. -/
@[to_additive AddEquiv.toAddMonCatIso
      "Build an isomorphism in the category `AddMon` from\nan `add_equiv` between `add_monoid`s.",
  simps]
def MulEquiv.toMonCatIso (e : X ≃* Y) : MonCat.of X ≅ MonCat.of Y
    where
  Hom := e.toMonoidHom
  inv := e.symm.toMonoidHom
#align mul_equiv.to_Mon_iso MulEquiv.toMonCatIso
#align add_equiv.to_AddMon_iso AddEquiv.toAddMonCatIso

end

section

variable [CommMonoid X] [CommMonoid Y]

/- warning: mul_equiv.to_CommMon_iso -> MulEquiv.toCommMonCatIso is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : CommMonoid.{u1} X] [_inst_2 : CommMonoid.{u1} Y], (MulEquiv.{u1, u1} X Y (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X (CommMonoid.toMonoid.{u1} X _inst_1))) (MulOneClass.toHasMul.{u1} Y (Monoid.toMulOneClass.{u1} Y (CommMonoid.toMonoid.{u1} Y _inst_2)))) -> (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} (CommMonCat.of.{u1} X _inst_1) (CommMonCat.of.{u1} Y _inst_2))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : CommMonoid.{u1} X] [_inst_2 : CommMonoid.{u1} Y], (MulEquiv.{u1, u1} X Y (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X (CommMonoid.toMonoid.{u1} X _inst_1))) (MulOneClass.toMul.{u1} Y (Monoid.toMulOneClass.{u1} Y (CommMonoid.toMonoid.{u1} Y _inst_2)))) -> (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} (CommMonCat.of.{u1} X _inst_1) (CommMonCat.of.{u1} Y _inst_2))
Case conversion may be inaccurate. Consider using '#align mul_equiv.to_CommMon_iso MulEquiv.toCommMonCatIsoₓ'. -/
/-- Build an isomorphism in the category `CommMon` from a `mul_equiv` between `comm_monoid`s. -/
@[to_additive AddEquiv.toAddCommMonCatIso
      "Build an isomorphism in the category `AddCommMon`\nfrom an `add_equiv` between `add_comm_monoid`s.",
  simps]
def MulEquiv.toCommMonCatIso (e : X ≃* Y) : CommMonCat.of X ≅ CommMonCat.of Y
    where
  Hom := e.toMonoidHom
  inv := e.symm.toMonoidHom
#align mul_equiv.to_CommMon_iso MulEquiv.toCommMonCatIso
#align add_equiv.to_AddCommMon_iso AddEquiv.toAddCommMonCatIso

end

namespace CategoryTheory.Iso

/- warning: category_theory.iso.Mon_iso_to_mul_equiv -> CategoryTheory.Iso.monCatIsoToMulEquiv is a dubious translation:
lean 3 declaration is
  forall {X : MonCat.{u1}} {Y : MonCat.{u1}}, (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} X Y) -> (MulEquiv.{u1, u1} (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} X) (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} Y) (MulOneClass.toHasMul.{u1} (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} X) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} X) (MonCat.monoid.{u1} X))) (MulOneClass.toHasMul.{u1} (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} Y) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.hasCoeToSort.{u1} Y) (MonCat.monoid.{u1} Y))))
but is expected to have type
  forall {X : MonCat.{u1}} {Y : MonCat.{u1}}, (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} X Y) -> (MulEquiv.{u1, u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} X) (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} Y) (MulOneClass.toMul.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} X) (Monoid.toMulOneClass.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} X) (MonCat.instMonoidCoeMonCatTypeInstCoeSortMonCatType.{u1} X))) (MulOneClass.toMul.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} Y) (Monoid.toMulOneClass.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} MonCat.{u1} Type.{u1} MonCat.instCoeSortMonCatType.{u1} Y) (MonCat.instMonoidCoeMonCatTypeInstCoeSortMonCatType.{u1} Y))))
Case conversion may be inaccurate. Consider using '#align category_theory.iso.Mon_iso_to_mul_equiv CategoryTheory.Iso.monCatIsoToMulEquivₓ'. -/
/-- Build a `mul_equiv` from an isomorphism in the category `Mon`. -/
@[to_additive AddMon_iso_to_add_equiv
      "Build an `add_equiv` from an isomorphism in the category\n`AddMon`."]
def monCatIsoToMulEquiv {X Y : MonCat} (i : X ≅ Y) : X ≃* Y :=
  i.Hom.toMulEquiv i.inv i.hom_inv_id i.inv_hom_id
#align category_theory.iso.Mon_iso_to_mul_equiv CategoryTheory.Iso.monCatIsoToMulEquiv
#align category_theory.iso.AddMon_iso_to_add_equiv CategoryTheory.Iso.addMonCatIsoToAddEquiv

/- warning: category_theory.iso.CommMon_iso_to_mul_equiv -> CategoryTheory.Iso.commMonCatIsoToMulEquiv is a dubious translation:
lean 3 declaration is
  forall {X : CommMonCat.{u1}} {Y : CommMonCat.{u1}}, (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} X Y) -> (MulEquiv.{u1, u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} X) (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} Y) (MulOneClass.toHasMul.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} X) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} X) (CommMonoid.toMonoid.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} X) (CommMonCat.commMonoid.{u1} X)))) (MulOneClass.toHasMul.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} Y) (Monoid.toMulOneClass.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} Y) (CommMonoid.toMonoid.{u1} (coeSort.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.hasCoeToSort.{u1} Y) (CommMonCat.commMonoid.{u1} Y)))))
but is expected to have type
  forall {X : CommMonCat.{u1}} {Y : CommMonCat.{u1}}, (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} X Y) -> (MulEquiv.{u1, u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} X) (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} Y) (MulOneClass.toMul.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} X) (Monoid.toMulOneClass.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} X) (CommMonoid.toMonoid.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} X) (CommMonCat.instCommMonoidCoeCommMonCatTypeInstCoeSortCommMonCatType.{u1} X)))) (MulOneClass.toMul.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} Y) (Monoid.toMulOneClass.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} Y) (CommMonoid.toMonoid.{u1} (CoeSort.coe.{succ (succ u1), succ (succ u1)} CommMonCat.{u1} Type.{u1} CommMonCat.instCoeSortCommMonCatType.{u1} Y) (CommMonCat.instCommMonoidCoeCommMonCatTypeInstCoeSortCommMonCatType.{u1} Y)))))
Case conversion may be inaccurate. Consider using '#align category_theory.iso.CommMon_iso_to_mul_equiv CategoryTheory.Iso.commMonCatIsoToMulEquivₓ'. -/
/-- Build a `mul_equiv` from an isomorphism in the category `CommMon`. -/
@[to_additive "Build an `add_equiv` from an isomorphism in the category\n`AddCommMon`."]
def commMonCatIsoToMulEquiv {X Y : CommMonCat} (i : X ≅ Y) : X ≃* Y :=
  i.Hom.toMulEquiv i.inv i.hom_inv_id i.inv_hom_id
#align category_theory.iso.CommMon_iso_to_mul_equiv CategoryTheory.Iso.commMonCatIsoToMulEquiv
#align category_theory.iso.CommMon_iso_to_add_equiv CategoryTheory.Iso.commMonCatIsoToAddEquiv

end CategoryTheory.Iso

/- warning: mul_equiv_iso_Mon_iso -> mulEquivIsoMonCatIso is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y], CategoryTheory.Iso.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1} (MulEquiv.{u1, u1} X Y (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X _inst_1)) (MulOneClass.toHasMul.{u1} Y (Monoid.toMulOneClass.{u1} Y _inst_2))) (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : Monoid.{u1} X] [_inst_2 : Monoid.{u1} Y], CategoryTheory.Iso.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1} (MulEquiv.{u1, u1} X Y (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X _inst_1)) (MulOneClass.toMul.{u1} Y (Monoid.toMulOneClass.{u1} Y _inst_2))) (CategoryTheory.Iso.{u1, succ u1} MonCat.{u1} MonCat.largeCategory.{u1} (MonCat.of.{u1} X _inst_1) (MonCat.of.{u1} Y _inst_2))
Case conversion may be inaccurate. Consider using '#align mul_equiv_iso_Mon_iso mulEquivIsoMonCatIsoₓ'. -/
/-- multiplicative equivalences between `monoid`s are the same as (isomorphic to) isomorphisms
in `Mon` -/
@[to_additive addEquivIsoAddMonCatIso
      "additive equivalences between `add_monoid`s are the same\nas (isomorphic to) isomorphisms in `AddMon`"]
def mulEquivIsoMonCatIso {X Y : Type u} [Monoid X] [Monoid Y] : X ≃* Y ≅ MonCat.of X ≅ MonCat.of Y
    where
  Hom e := e.toMonCatIso
  inv i := i.monCatIsoToMulEquiv
#align mul_equiv_iso_Mon_iso mulEquivIsoMonCatIso
#align add_equiv_iso_AddMon_iso addEquivIsoAddMonCatIso

/- warning: mul_equiv_iso_CommMon_iso -> mulEquivIsoCommMonCatIso is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : CommMonoid.{u1} X] [_inst_2 : CommMonoid.{u1} Y], CategoryTheory.Iso.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1} (MulEquiv.{u1, u1} X Y (MulOneClass.toHasMul.{u1} X (Monoid.toMulOneClass.{u1} X (CommMonoid.toMonoid.{u1} X _inst_1))) (MulOneClass.toHasMul.{u1} Y (Monoid.toMulOneClass.{u1} Y (CommMonoid.toMonoid.{u1} Y _inst_2)))) (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} (CommMonCat.of.{u1} X _inst_1) (CommMonCat.of.{u1} Y _inst_2))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u1}} [_inst_1 : CommMonoid.{u1} X] [_inst_2 : CommMonoid.{u1} Y], CategoryTheory.Iso.{u1, succ u1} Type.{u1} CategoryTheory.types.{u1} (MulEquiv.{u1, u1} X Y (MulOneClass.toMul.{u1} X (Monoid.toMulOneClass.{u1} X (CommMonoid.toMonoid.{u1} X _inst_1))) (MulOneClass.toMul.{u1} Y (Monoid.toMulOneClass.{u1} Y (CommMonoid.toMonoid.{u1} Y _inst_2)))) (CategoryTheory.Iso.{u1, succ u1} CommMonCat.{u1} CommMonCat.largeCategory.{u1} (CommMonCat.of.{u1} X _inst_1) (CommMonCat.of.{u1} Y _inst_2))
Case conversion may be inaccurate. Consider using '#align mul_equiv_iso_CommMon_iso mulEquivIsoCommMonCatIsoₓ'. -/
/-- multiplicative equivalences between `comm_monoid`s are the same as (isomorphic to) isomorphisms
in `CommMon` -/
@[to_additive addEquivIsoAddCommMonCatIso
      "additive equivalences between `add_comm_monoid`s are\nthe same as (isomorphic to) isomorphisms in `AddCommMon`"]
def mulEquivIsoCommMonCatIso {X Y : Type u} [CommMonoid X] [CommMonoid Y] :
    X ≃* Y ≅ CommMonCat.of X ≅ CommMonCat.of Y
    where
  Hom e := e.toCommMonCatIso
  inv i := i.commMonCatIsoToMulEquiv
#align mul_equiv_iso_CommMon_iso mulEquivIsoCommMonCatIso
#align add_equiv_iso_AddCommMon_iso addEquivIsoAddCommMonCatIso

#print MonCat.forget_reflects_isos /-
@[to_additive]
instance MonCat.forget_reflects_isos : ReflectsIsomorphisms (forget MonCat.{u})
    where reflects X Y f _ := by
    skip
    let i := as_iso ((forget MonCat).map f)
    let e : X ≃* Y := { f, i.to_equiv with }
    exact ⟨(is_iso.of_iso e.to_Mon_iso).1⟩
#align Mon.forget_reflects_isos MonCat.forget_reflects_isos
#align AddMon.forget_reflects_isos AddMonCat.forget_reflects_isos
-/

#print CommMonCat.forget_reflects_isos /-
@[to_additive]
instance CommMonCat.forget_reflects_isos : ReflectsIsomorphisms (forget CommMonCat.{u})
    where reflects X Y f _ := by
    skip
    let i := as_iso ((forget CommMonCat).map f)
    let e : X ≃* Y := { f, i.to_equiv with }
    exact ⟨(is_iso.of_iso e.to_CommMon_iso).1⟩
#align CommMon.forget_reflects_isos CommMonCat.forget_reflects_isos
#align AddCommMon.forget_reflects_isos AddCommMonCat.forget_reflects_isos
-/

/-!
Once we've shown that the forgetful functors to type reflect isomorphisms,
we automatically obtain that the `forget₂` functors between our concrete categories
reflect isomorphisms.
-/

example : ReflectsIsomorphisms (forget₂ CommMonCat MonCat) := by infer_instance


import util.classical

universes u v

variables {α : Type u}
variables {β : Type v}
variables {p q : α → Prop}
variables Hall : ∀ x, p x → q x
variables Hex : ∃ x, p x

lemma some_spec_test1
: p (classical.some Hex) :=
by apply_some_spec

section
include Hall

lemma some_spec_test2
: q (classical.some Hex) :=
by apply_some_spec

end

variables Hpq : ∀ x, p x → q x
lemma Hex : ∃ x, p x := sorry
open classical
include Hpq
variable [nonempty α]
example : q (ε x, p x) :=
begin
  apply_epsilon_spec Hex,
end


import category_theory.full_subcategory
import category_theory.groupoid
import category_theory.functor
import category_theory.endomorphism
import category_theory.is_connected

namespace category_theory.groupoid
section
open category_theory

@[simp] lemma comp_inv_x {G : Type*} [category_theory.groupoid G] {x y z : G}
                {f : x ⟶ y} {g : x ⟶ z} : f ≫ (inv f) ≫ g = g :=
by rw [← category.assoc, comp_inv, category.id_comp]

@[simp] lemma inv_comp_x {G : Type*} [category_theory.groupoid G] {x y z : G}
                {f : y ⟶ x} {g : x ⟶ z} : (inv f) ≫ f ≫ g = g :=
by rw [← category.assoc, inv_comp, category.id_comp]

@[simp] lemma mul_def_Aut {C : Type*} [category_theory.category C] {x : C} (a b : category_theory.Aut x) :
  a * b = b.trans a := rfl

end

section

lemma groupoid_connected_of_homs {G : Type*} [category_theory.groupoid G]
  [nonempty G] (iso : ∀ (x y : G), nonempty (x ⟶ y)) : category_theory.is_connected G :=
  category_theory.zigzag_is_connected (λ j₁ j₂, relation.refl_trans_gen.single
    (or.inl (iso j₁ j₂)))

lemma groupoid_connected_iff_hom {G : Type*} [category_theory.groupoid G] [nonempty G] :
  category_theory.is_connected G ↔ ∀ (x y : G), nonempty (x ⟶ y) :=
⟨λ conn, @category_theory.nonempty_hom_of_connected_groupoid G _ conn, groupoid_connected_of_homs⟩

lemma groupoid_connected_iff_iso {G : Type*} [category_theory.groupoid G] [nonempty G] :
  category_theory.is_connected G ↔ ∀ (x y : G), nonempty (x ≅ y) :=
begin
  simp_rw (λ (x y : G), equiv.nonempty_congr (category_theory.groupoid.iso_equiv_hom x y)),
  exact groupoid_connected_iff_hom,
end

end

section
variables {g : Type*} [category_theory.groupoid g]
            (x₁ : g) (x₂ : g)
          {C : Type*} [category_theory.category C]
            {y₁ y₂ : C}

@[reducible]
def to_group (x : g) := category_theory.End x

def iso_induces_iso_of_Aut (f : y₁ ≅ y₂) : category_theory.Aut y₁ ≃* category_theory.Aut y₂ :=
{ to_fun := λ a, { hom := f.inv ≫ a.hom ≫ f.hom,
                   inv := f.inv ≫ a.inv ≫ f.hom,
                   hom_inv_id' := by simp, inv_hom_id' := by simp },
  inv_fun := λ a, { hom := f.hom ≫ a.hom ≫ f.inv,
                    inv := f.hom ≫ a.inv ≫ f.inv,
                    hom_inv_id' := by simp,
                    inv_hom_id' := by simp, },
  left_inv := by { intro, ext, simp, },
  right_inv := by { intro, ext, simp, },
  map_mul' := by { intros, ext, simp, } }

def to_group_is_Aut (x : g) : category_theory.Aut x ≃* to_group x :=
{ map_mul' := λ a b, rfl
  ..(category_theory.groupoid.iso_equiv_hom x x) }

def to_group_iso (f : x₁ ⟶ x₂) : to_group x₁ ≃* to_group x₂ :=
  ((to_group_is_Aut x₁).symm.trans
  (iso_induces_iso_of_Aut ((category_theory.groupoid.iso_equiv_hom x₁ x₂).inv_fun f))).trans
  (to_group_is_Aut x₂)

lemma to_group_iso_to_fun (f : x₁ ⟶ x₂) : (to_group_iso x₁ x₂ f).to_fun = λ a, (inv f) ≫ a ≫ f := rfl
lemma to_group_iso_inv_fun (f : x₁ ⟶ x₂) : (to_group_iso x₁ x₂ f).inv_fun = λ a, f ≫ a ≫ (inv f) := rfl

lemma to_group_iso_connected [category_theory.is_connected g] :
  nonempty (to_group x₁ ≃* to_group x₂) := nonempty.map (to_group_iso x₁ x₂) (category_theory.nonempty_hom_of_connected_groupoid x₁ x₂)

lemma nat_iso_of_groupoid_nat_trans {h : Type*} [category_theory.groupoid h] {a b : g ⥤ h} (nt : a ⟶ b) :
  category_theory.is_iso nt := category_theory.nat_iso.is_iso_of_is_iso_app nt

end

end category_theory.groupoid


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Eric Wieser
-/
import tactic.doc_commands

/-!
# Documentation of the algebraic hierarchy

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

A library note giving advice on modifying the algebraic hierarchy.
(It is not intended as a "tour".)

TODO: Add sections about interactions with topological typeclasses, and order typeclasses.

-/

/--
# The algebraic hierarchy

In any theorem proving environment,
there are difficult decisions surrounding the design of the "algebraic hierarchy".

There is a danger of exponential explosion in the number of gadgets,
especially once interactions between algebraic and order/topological/etc structures are considered.

In mathlib, we try to avoid this by only introducing new algebraic typeclasses either
1. when there is "real mathematics" to be done with them, or
2. when there is a meaninful gain in simplicity by factoring out a common substructure.

(As examples, at this point we don't have `loop`, or `unital_magma`,
but we do have `lie_submodule` and `topological_field`!
We also have `group_with_zero`, as an exemplar of point 2.)

Generally in mathlib we use the extension mechanism (so `comm_ring` extends `ring`)
rather than mixins (e.g. with separate `ring` and `comm_mul` classes),
in part because of the potential blow-up in term sizes described at
https://www.ralfj.de/blog/2019/05/15/typeclasses-exponential-blowup.html
However there is tension here, as it results in considerable duplication in the API,
particularly in the interaction with order structures.

This library note is not intended as a design document
justifying and explaining the history of mathlib's algebraic hierarchy!
Instead it is intended as a developer's guide, for contributors wanting to extend
(either new leaves, or new intermediate classes) the algebraic hierarchy as it exists.

(Ideally we would have both a tour guide to the existing hierarchy,
and an account of the design choices.
See https://arxiv.org/abs/1910.09336 for an overview of mathlib as a whole,
with some attention to the algebraic hierarchy and
https://leanprover-community.github.io/mathlib-overview.html
for a summary of what is in mathlib today.)

## Instances

When adding a new typeclass `Z` to the algebraic hierarchy
one should attempt to add the following constructions and results,
when applicable:

* Instances transferred elementwise to products, like `prod.monoid`.
  See `algebra.group.prod` for more examples.
  ```
  instance prod.Z [Z M] [Z N] : Z (M × N) := ...
  ```
* Instances transferred elementwise to pi types, like `pi.monoid`.
  See `algebra.group.pi` for more examples.
  ```
  instance pi.Z [∀ i, Z $ f i] : Z (Π i : I, f i) := ...
  ```
* Instances transferred to `mul_opposite M`, like `mul_opposite.monoid`.
  See `algebra.opposites` for more examples.
  ```
  instance mul_opposite.Z [Z M] : Z (mul_opposite M) := ...
  ```
* Instances transferred to `ulift M`, like `ulift.monoid`.
  See `algebra.group.ulift` for more examples.
  ```
  instance ulift.Z [Z M] : Z (ulift M) := ...
  ```
* Definitions for transferring the proof fields of instances along
  injective or surjective functions that agree on the data fields,
  like `function.injective.monoid` and `function.surjective.monoid`.
  We make these definitions `@[reducible]`, see note [reducible non-instances].
  See `algebra.group.inj_surj` for more examples.
  ```
  @[reducible]
  def function.injective.Z [Z M₂] (f : M₁ → M₂) (hf : injective f)
    (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) : Z M₁ := ...

  @[reducible]
  def function.surjective.Z [Z M₁] (f : M₁ → M₂) (hf : surjective f)
    (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) : Z M₂ := ...
  ```
* Instances transferred elementwise to `finsupp`s, like `finsupp.semigroup`.
  See `data.finsupp.pointwise` for more examples.
  ```
  instance finsupp.Z [Z β] : Z (α →₀ β) := ...
  ```
* Instances transferred elementwise to `set`s, like `set.monoid`.
  See `algebra.pointwise` for more examples.
  ```
  instance set.Z [Z α] : Z (set α) := ...
  ```
* Definitions for transferring the entire structure across an equivalence, like `equiv.monoid`.
  See `data.equiv.transfer_instance` for more examples. See also the `transport` tactic.
  ```
  def equiv.Z (e : α ≃ β) [Z β] : Z α := ...
  /- When there is a new notion of `Z`-equiv: -/
  def equiv.Z_equiv (e : α ≃ β) [Z β] : by { letI := equiv.Z e, exact α ≃Z β } := ...
  ```

## Subobjects

When a new typeclass `Z` adds new data fields,
you should also create a new `sub_Z` `structure` with a `carrier` field.

This can be a lot of work; for now try to closely follow the existing examples
(e.g. `submonoid`, `subring`, `subalgebra`).
We would very much like to provide some automation here, but a prerequisite will be making
all the existing APIs more uniform.

If `Z` extends `Y`, then `sub_Z` should usually extend `sub_Y`.

When `Z` adds only new proof fields to an existing structure `Y`,
you should provide instances transferring
`Z α` to `Z (sub_Y α)`, like `submonoid.to_comm_monoid`.
Typically this is done using the `function.injective.Z` definition mentioned above.
```
instance sub_Y.to_Z [Z α] : Z (sub_Y α) :=
coe_injective.Z coe ...
```

## Morphisms and equivalences

## Category theory

For many algebraic structures, particularly ones used in representation theory, algebraic geometry,
etc., we also define "bundled" versions, which carry `category` instances.

These bundled versions are usually named in camel case,
so for example we have `AddCommGroup` as a bundled `add_comm_group`,
and `TopCommRing` (which bundles together `comm_ring`, `topological_space`, and `topological_ring`).

These bundled versions have many appealing features:
* a uniform notation for morphisms `X ⟶ Y`
* a uniform notation (and definition) for isomorphisms `X ≅ Y`
* a uniform API for subobjects, via the partial order `subobject X`
* interoperability with unbundled structures, via coercions to `Type`
  (so if `G : AddCommGroup`, you can treat `G` as a type,
  and it automatically has an `add_comm_group` instance)
  and lifting maps `AddCommGroup.of G`, when `G` is a type with an `add_comm_group` instance.

If, for example you do the work of proving that a typeclass `Z` has a good notion of tensor product,
you are strongly encouraged to provide the corresponding `monoidal_category` instance
on a bundled version.
This ensures that the API for tensor products is complete, and enables use of general machinery.
Similarly if you prove universal properties, or adjunctions, you are encouraged to state these
using categorical language!

One disadvantage of the bundled approach is that we can only speak of morphisms between
objects living in the same type-theoretic universe.
In practice this is rarely a problem.

# Making a pull request

With so many moving parts, how do you actually go about changing the algebraic hierarchy?

We're still evolving how to handle this, but the current suggestion is:

* If you're adding a new "leaf" class, the requirements are lower,
  and an initial PR can just add whatever is immediately needed.
* A new "intermediate" class, especially low down in the hierarchy,
  needs to be careful about leaving gaps.

In a perfect world, there would be a group of simultaneous PRs that basically cover everything!
(Or at least an expectation that PRs may not be merged immediately while waiting on other
PRs that fill out the API.)

However "perfect is the enemy of good", and it would also be completely reasonable
to add a TODO list in the main module doc-string for the new class,
briefly listing the parts of the API which still need to be provided.
Hopefully this document makes it easy to assemble this list.

Another alternative to a TODO list in the doc-strings is adding github issues.

-/
library_note "the algebraic hierarchy"

/--
Some definitions that define objects of a class cannot be instances, because they have an
explicit argument that does not occur in the conclusion. An example is `preorder.lift` that has a
function `f : α → β` as an explicit argument to lift a preorder on `β` to a preorder on `α`.

If these definitions are used to define instances of this class *and* this class is an argument to
some other type-class so that type-class inference will have to unfold these instances to check
for definitional equality, then these definitions should be marked `@[reducible]`.

For example, `preorder.lift` is used to define `units.preorder` and `partial_order.lift` is used
to define `units.partial_order`. In some cases it is important that type-class inference can
recognize that `units.preorder` and `units.partial_order` give rise to the same `has_le` instance.
For example, you might have another class that takes `[has_le α]` as an argument, and this argument
sometimes comes from `units.preorder` and sometimes from `units.partial_order`.
Therefore, `preorder.lift` and `partial_order.lift` are marked `@[reducible]`.
-/
library_note "reducible non-instances"


import Lean
import Lean.Meta.Basic
import Lean.Elab.Tactic.Basic

import SciLean.Prelude

import Lean.Elab.Tactic.Conv.Basic

namespace Function

  def scomb {α β γ} (f : α → β → γ) (g : α → β) (x : α) := f x (g x)
  def diag {α β} (f : α → α → β) (x : α) := f x x

end Function

namespace Lean.Elab.Tactic.Conv
open Meta

open Lean
open Lean.Meta
open Lean.Elab.Tactic

def extractfvar (e : Expr) (v : Expr) (lctx : LocalContext) : MetaM Expr := do
withLCtx lctx #[] do
let V ← inferType v
let fvarid := v.fvarId!
let E ← inferType e
let u ← getLevel E
match e with
  | Expr.fvar fvarid' => if (fvarid'==fvarid) then pure (mkApp (mkConst ``id [u]) E) else (mkAppM ``Function.const #[V, e])
  | Expr.app f x =>
    match (f.containsFVar fvarid), (x.containsFVar fvarid) with
      | false, false => mkAppM ``Function.const #[V, e]
      | false, true => if (x==v) then pure f else mkAppM ``Function.comp #[f, (← extractfvar x v lctx)]
      | true, false => mkAppM ``Function.swap #[(← extractfvar f v lctx), x]
      | true, true => -- mkAppM `subs #[(← extractfvar f v lctx), (← extractfvar x v lctx)]
                      if (x==v) then
                        mkAppM ``Function.diag #[(← extractfvar f v lctx)]
                      else
                        mkAppM ``Function.scomb #[(← extractfvar f v lctx), (← extractfvar x v lctx)]
  | e => pure e

partial def removelambdalet (e : Expr) (lctx : LocalContext) : MetaM Expr :=
withLCtx lctx #[] do
match e with
 | Expr.app f x => pure $ mkApp (← removelambdalet f lctx) (← removelambdalet x lctx)
 | Expr.lam .. => lambdaTelescope e fun xs b => do
   let xs := xs.reverse
   let mut b ← removelambdalet b (← getLCtx)
   -- let B ← inferType b
   for x in xs do
     -- if ¬(B.containsFVar x.fvarId!) then
     b ← extractfvar b x (← getLCtx)
     -- else
     --   b ← mkLambdaFVars #[x] b
   pure b
 | Expr.letE n t v b _ => do
     let lctx ← getLCtx
     let fvarId ← mkFreshFVarId
     let lctx := lctx.mkLetDecl fvarId n t v
     let fvar := mkFVar fvarId
     let b := b.instantiate #[fvar]
     let b ← removelambdalet b lctx
     let b ← extractfvar b fvar lctx
     let v ← removelambdalet v lctx
     pure $ mkApp b v
 | e' => pure e'

syntax (name := rmlamlet) "rmlamlet" : tactic

def rmlamletCore (mvarId : MVarId) : MetaM (List MVarId) :=
  mvarId.withContext do
    let tag      ← mvarId.getTag
    let target   ← mvarId.getType
    -- let u        ← getLevel target
    let targetNew ← (removelambdalet target (← getLCtx))
    let mvarNew  ← mkFreshExprSyntheticOpaqueMVar targetNew tag
    -- let eq       ← mkEq target targetNew
    -- let eqMvar  ← mkFreshExprSyntheticOpaqueMVar eq
    -- let val  := mkAppN (Lean.mkConst `Eq.mpr [u]) #[target, targetNew, eqMvar, mvarNew]
    -- assignExprMVar mvarId var
    mvarId.assign mvarNew
    return [mvarNew.mvarId!]

@[tactic rmlamlet] def tacticRemoveLambdaLet : Tactic
| _ => do
          let mainGoal ← getMainGoal
          let todos ← rmlamletCore mainGoal
          setGoals todos
          pure ()

syntax (name := conv_rmlamlet) "rmlamlet" : conv

@[tactic conv_rmlamlet] def tacticConvRemoveLambdaLet : Tactic :=
fun stx => withMainContext do
          let lhs ← instantiateMVars (← getLhs)
          changeLhs (← removelambdalet lhs (← getLCtx))
          pure ()

example : (λ x : Nat => x + x) = (λ _ => 0) :=
by
  rmlamlet
  admit
  done

open Function

example (sum : {k : Nat} → (Fin k → Nat) → Nat) (A : Fin n → Fin m → Nat) (x : Fin m → Nat)
  : (λ i => sum λ j => A i j * x j) = (λ _ => 0) :=
by
  rmlamlet
  admit
  done

-- syntax (name := print_goal) "print_goal" : conv

-- @[tactic print_goal] def tacticPrintGoal : Tactic :=
-- fun stx => withMainContext do
--           let mainGoal ← getMainGoal
--           withMVarContext mainGoal do
--             let (lhs, rhs) ← getLhsRhsCore mainGoal
--             let lhs ← instantiateMVars lhs
--             let rhs ← instantiateMVars rhs
--             IO.println s!"Goal: {← getMVarType (← getMainGoal)}"
--             IO.println s!"lhs & rhs: {lhs} | {rhs}"
--             pure ()

-- syntax (name := print_lhs) "print_lhs" : conv

-- @[tactic print_lhs] def tacticPrintLhs : Tactic :=
-- fun stx => withMainContext do
--           changeLhs (← instantiateMVars (← getLhs))
--           IO.println s!"Lhs: {← instantiateMVars (← getLhs)}"
--           pure ()

-- syntax (name := print_rhs) "print_rhs" : conv

-- @[tactic print_rhs] def tacticPrintRhs : Tactic :=
-- fun stx => withMainContext do
--           IO.println s!"Rhs: {← instantiateMVars (← getRhs)}"
--           pure ()

-- def test : id (id (λ x : Nat => id (id x))) = λ x => x := by

--   conv =>
--     print_lhs
--     lhs
--     print_lhs
--     enter [1,1]
--     print_lhsv
--     rmlamlet
--     enter [x]
--     simp
--     print_lhs
--     print_rhs
--     print_goal
--   done


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Patrick Massot, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monad.limits
import Mathlib.topology.uniform_space.completion
import Mathlib.topology.category.Top.basic
import Mathlib.PostPort

universes u u_1 l

namespace Mathlib

/-!
# The category of uniform spaces

We construct the category of uniform spaces, show that the complete separated uniform spaces
form a reflective subcategory, and hence possess all limits that uniform spaces do.

TODO: show that uniform spaces actually have all limits!
-/

/-- A (bundled) uniform space. -/
def UniformSpace := category_theory.bundled uniform_space

namespace UniformSpace

/-- The information required to build morphisms for `UniformSpace`. -/
protected instance uniform_continuous.category_theory.unbundled_hom :
    category_theory.unbundled_hom uniform_continuous :=
  category_theory.unbundled_hom.mk uniform_continuous_id uniform_continuous.comp

protected instance has_coe_to_sort : has_coe_to_sort UniformSpace :=
  category_theory.bundled.has_coe_to_sort

protected instance uniform_space (x : UniformSpace) : uniform_space ↥x :=
  category_theory.bundled.str x

/-- Construct a bundled `UniformSpace` from the underlying type and the typeclass. -/
def of (α : Type u) [uniform_space α] : UniformSpace := category_theory.bundled.mk α

protected instance inhabited : Inhabited UniformSpace := { default := of empty }

@[simp] theorem coe_of (X : Type u) [uniform_space X] : ↥(of X) = X := rfl

protected instance category_theory.has_hom.hom.has_coe_to_fun (X : UniformSpace)
    (Y : UniformSpace) : has_coe_to_fun (X ⟶ Y) :=
  has_coe_to_fun.mk (fun (_x : X ⟶ Y) => ↥X → ↥Y)
    (category_theory.functor.map (category_theory.forget UniformSpace))

@[simp] theorem coe_comp {X : UniformSpace} {Y : UniformSpace} {Z : UniformSpace} (f : X ⟶ Y)
    (g : Y ⟶ Z) : ⇑(f ≫ g) = ⇑g ∘ ⇑f :=
  rfl

@[simp] theorem coe_id (X : UniformSpace) : ⇑𝟙 = id := rfl

@[simp] theorem coe_mk {X : UniformSpace} {Y : UniformSpace} (f : ↥X → ↥Y)
    (hf : uniform_continuous f) : ⇑{ val := f, property := hf } = f :=
  rfl

theorem hom_ext {X : UniformSpace} {Y : UniformSpace} {f : X ⟶ Y} {g : X ⟶ Y} : ⇑f = ⇑g → f = g :=
  subtype.eq

/-- The forgetful functor from uniform spaces to topological spaces. -/
protected instance has_forget_to_Top : category_theory.has_forget₂ UniformSpace Top :=
  category_theory.has_forget₂.mk
    (category_theory.functor.mk (fun (X : UniformSpace) => Top.of ↥X)
      fun (X Y : UniformSpace) (f : X ⟶ Y) => continuous_map.mk ⇑f)

end UniformSpace

/-- A (bundled) complete separated uniform space. -/
structure CpltSepUniformSpace where
  α : Type u
  is_uniform_space : uniform_space α
  is_complete_space : complete_space α
  is_separated : separated_space α

namespace CpltSepUniformSpace

protected instance has_coe_to_sort : has_coe_to_sort CpltSepUniformSpace :=
  has_coe_to_sort.mk (Type u) α

def to_UniformSpace (X : CpltSepUniformSpace) : UniformSpace := UniformSpace.of ↥X

protected instance complete_space (X : CpltSepUniformSpace) :
    complete_space (category_theory.bundled.α (to_UniformSpace X)) :=
  is_complete_space X

protected instance separated_space (X : CpltSepUniformSpace) :
    separated_space (category_theory.bundled.α (to_UniformSpace X)) :=
  is_separated X

/-- Construct a bundled `UniformSpace` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
    CpltSepUniformSpace :=
  mk X

@[simp] theorem coe_of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
    ↥(of X) = X :=
  rfl

protected instance inhabited : Inhabited CpltSepUniformSpace := { default := of empty }

/-- The category instance on `CpltSepUniformSpace`. -/
protected instance category : category_theory.large_category CpltSepUniformSpace :=
  category_theory.induced_category.category to_UniformSpace

/-- The concrete category instance on `CpltSepUniformSpace`. -/
protected instance concrete_category : category_theory.concrete_category CpltSepUniformSpace :=
  category_theory.induced_category.concrete_category to_UniformSpace

protected instance has_forget_to_UniformSpace :
    category_theory.has_forget₂ CpltSepUniformSpace UniformSpace :=
  category_theory.induced_category.has_forget₂ to_UniformSpace

end CpltSepUniformSpace

namespace UniformSpace

/-- The functor turning uniform spaces into complete separated uniform spaces. -/
def completion_functor : UniformSpace ⥤ CpltSepUniformSpace :=
  category_theory.functor.mk
    (fun (X : UniformSpace) => CpltSepUniformSpace.of (uniform_space.completion ↥X))
    fun (X Y : UniformSpace) (f : X ⟶ Y) =>
      { val := uniform_space.completion.map (subtype.val f), property := sorry }

/-- The inclusion of a uniform space into its completion. -/
def completion_hom (X : UniformSpace) :
    X ⟶
        category_theory.functor.obj (category_theory.forget₂ CpltSepUniformSpace UniformSpace)
          (category_theory.functor.obj completion_functor X) :=
  { val := coe, property := sorry }

@[simp] theorem completion_hom_val (X : UniformSpace) (x : ↥X) : coe_fn (completion_hom X) x = ↑x :=
  rfl

/-- The mate of a morphism from a `UniformSpace` to a `CpltSepUniformSpace`. -/
def extension_hom {X : UniformSpace} {Y : CpltSepUniformSpace}
    (f :
      X ⟶
        category_theory.functor.obj (category_theory.forget₂ CpltSepUniformSpace UniformSpace) Y) :
    category_theory.functor.obj completion_functor X ⟶ Y :=
  { val := uniform_space.completion.extension ⇑f, property := sorry }

@[simp] theorem extension_hom_val {X : UniformSpace} {Y : CpltSepUniformSpace}
    (f :
      X ⟶ category_theory.functor.obj (category_theory.forget₂ CpltSepUniformSpace UniformSpace) Y)
    (x :
      ↥(CpltSepUniformSpace.to_UniformSpace (category_theory.functor.obj completion_functor X))) :
    coe_fn (extension_hom f) x = uniform_space.completion.extension (⇑f) x :=
  rfl

@[simp] theorem extension_comp_coe {X : UniformSpace} {Y : CpltSepUniformSpace}
    (f :
      CpltSepUniformSpace.to_UniformSpace (CpltSepUniformSpace.of (uniform_space.completion ↥X)) ⟶
        CpltSepUniformSpace.to_UniformSpace Y) :
    extension_hom (completion_hom X ≫ f) = f :=
  sorry

/-- The completion functor is left adjoint to the forgetful functor. -/
def adj : completion_functor ⊣ category_theory.forget₂ CpltSepUniformSpace UniformSpace :=
  category_theory.adjunction.mk_of_hom_equiv
    (category_theory.adjunction.core_hom_equiv.mk
      fun (X : UniformSpace) (Y : CpltSepUniformSpace) =>
        equiv.mk
          (fun (f : category_theory.functor.obj completion_functor X ⟶ Y) => completion_hom X ≫ f)
          (fun
            (f :
            X ⟶
              category_theory.functor.obj (category_theory.forget₂ CpltSepUniformSpace UniformSpace)
                Y) =>
            extension_hom f)
          sorry sorry)

protected instance category_theory.forget₂.category_theory.is_right_adjoint :
    category_theory.is_right_adjoint (category_theory.forget₂ CpltSepUniformSpace UniformSpace) :=
  category_theory.is_right_adjoint.mk completion_functor adj

protected instance category_theory.forget₂.category_theory.reflective :
    category_theory.reflective (category_theory.forget₂ CpltSepUniformSpace UniformSpace) :=
  category_theory.reflective.mk

end Mathlib


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  . exact hp
  . apply And.intro
    . exact hq
    . exact hp


import tactic
import category_theory.yoneda
import .sigma_category

open category_theory category_theory.functor

universes u v w

instance {𝒞 : Type u} [category 𝒞] (F : 𝒞 ⥤ Type v) : category_struct (sigma F.obj) :=
{ hom := λ X Y, { f : X.1 ⟶ Y.1 // F.map f X.2 = Y.2 },
  id := λ X, ⟨𝟙 X.1, by simp⟩,
  comp := λ X Y Z f g, ⟨f.1 ≫ g.1, by have := f.2; have := g.2; simp * at *⟩ }

instance {𝒞 : Type u} [category 𝒞] (F : 𝒞 ⥤ Type v) : category (sigma F.obj) :=
{ id_comp' := λ _ _ _, subtype.ext (category.id_comp _),
  comp_id' := λ _ _ _, subtype.ext (category.comp_id _),
  assoc' := λ _ _ _ _ _ _ _, subtype.ext (category.assoc _ _ _) }

def sigma.forget {𝒞 : Type u} [category 𝒞] (F : 𝒞 ⥤ Type v) : sigma F.obj ⥤ 𝒞 :=
{ obj := sigma.fst,
  map := λ _ _, subtype.val }

example {𝒞 : Type u} [category 𝒞] (X : 𝒞) :
  limits.is_initial (@sigma.mk 𝒞 (coyoneda.obj (opposite.op X)).obj X (𝟙 X)) :=
@limits.is_initial.of_unique _ _ (@sigma.mk 𝒞 (coyoneda.obj (opposite.op X)).obj X (𝟙 X))
  (λ Y, ⟨⟨⟨Y.2, category.id_comp Y.2⟩⟩, λ x, subtype.ext (begin
    have := x.2,
    dsimp at this,
    simp at this,
    simp [this]
  end)⟩)

noncomputable example {𝒞 : Type u} [category 𝒞] (F : 𝒞 ⥤ Type v) [corepresentable F] :
  limits.is_initial (@sigma.mk 𝒞 F.obj F.corepr_X F.corepr_x) :=
@limits.is_initial.of_unique _ _ (@sigma.mk 𝒞 F.obj F.corepr_X
    (F.corepr_w.hom.app F.corepr_X (𝟙 F.corepr_X)))
  (λ Y, ⟨⟨⟨((corepr_w F).app Y.fst).inv Y.snd, begin
    conv_rhs { rw [← (F.corepr_w.app Y.fst).to_equiv.apply_symm_apply Y.snd] },
    dsimp,
    generalize hy : F.corepr_w.inv.app Y.fst Y.snd = y,
    apply (F.corepr_w.app Y.fst).symm.to_equiv.injective,
    have := F.corepr_w.inv.naturality y,
    simp only [coyoneda, function.funext_iff] at this,
    dsimp at *,
    simp [this]
  end⟩⟩, λ x, subtype.ext begin
    have := x.2,
    dsimp at this,
    simp [← this],
    have := F.corepr_w.inv.naturality x.1,
    simp only [coyoneda, function.funext_iff] at this,
    dsimp at *,
    simp [this_1]
  end⟩)

example {𝒞 : Type u} [category 𝒞] (F : 𝒞 ⥤ Type v)
  (X : sigma F.obj) (h : limits.is_initial X) :
  coyoneda.obj (opposite.op ((sigma.forget F).obj X)) ≅ F :=
{ hom := { app := λ Y f, F.map f X.2 },
  inv := { app := λ Y y, (h.to ⟨Y, y⟩).val,
     naturality' := λ Y Z f, begin
       dsimp,
       funext y,
       dsimp,
       let g : X ⟶ ⟨Z, F.map f y⟩ := h.to ⟨Y, y⟩ ≫ ⟨f, rfl⟩,
       show _ = g.val,
       refine congr_arg subtype.val _,
       exact limits.is_initial.hom_ext h (h.to ⟨Z, F.map f y⟩) g,
     end },
  hom_inv_id' := begin
    dsimp,
    ext Y y,
    dsimp at *,
    let g : X ⟶ ⟨Y, F.map y X.snd⟩ := ⟨y, rfl⟩,
    show subtype.val (h.to ⟨Y, F.map y X.snd⟩) = ↑g,
    refine congr_arg subtype.val _,
    exact limits.is_initial.hom_ext h (h.to ⟨Y, F.map y X.snd⟩) g,
  end,
  inv_hom_id' := begin
    dsimp,
    ext Y y,
    exact (h.to ⟨Y, y⟩).2
  end  }


import unitb.logic

import unitb.models.nondet

import util.logic

import temporal_logic

universe variable u
namespace schedules

section schedules

open predicate

parameter α : Type

def pred := α → Prop

structure event : Type :=
  (coarse_sch : pred)
  (fine_sch : pred)
  (step : ∀ s, coarse_sch s → fine_sch s → α)

parameter {α}

def event.nondet (e : event) : nondet.event α :=
  { coarse_sch := e.coarse_sch
  , fine_sch := e.fine_sch
  , step := λ s Hc Hf s', e.step s Hc Hf = s'
  , fis := λ s Hc Hf, ⟨_,rfl⟩ }

structure program : Type 2 :=
  (lbl : Type)
  (lbl_is_sched : scheduling.sched lbl)
  (first : α)
  (event' : lbl → event)

def program.nondet (p : program) : @nondet.program α :=
  { lbl := p.lbl
  , lbl_is_sched := p.lbl_is_sched
  , first := λ s, s = p.first
  , first_fis := ⟨_, rfl⟩
  , event' := event.nondet ∘ p.event' }

open temporal

def program.coarse_sch_of (s : program) (act : option s.lbl)
: α → Prop :=
nondet.program.coarse_sch_of s.nondet act

def program.fine_sch_of (s : program) (act : option s.lbl) : α → Prop :=
nondet.program.fine_sch_of s.nondet act

def program.step_of (s : program) (act : option s.lbl) : α → α → Prop :=
s.nondet.step_of act

def is_step (s : program) : α → α → Prop :=
nondet.is_step s.nondet

def program.ex (s : program) (τ : stream α) : Prop :=
nondet.program.ex (s.nondet) τ

def program.falsify (s : program) (act : option s.lbl) (p q : pred' α) : Prop :=
nondet.program.falsify s.nondet act p q

open temporal

lemma program.falsify.negate
   {s : program} {act : option s.lbl} {p q : pred' α}
   (F : s.falsify act p q)
:  •q ⋀ ⟦ s^.step_of act ⟧ ⟹ ◇-•q :=
@nondet.program.falsify.negate _ s.nondet act p q F

def program.transient (s : program) : pred' α → pred' α → Prop :=
nondet.program.transient s.nondet

section theorems

variable (s : program)

open program
open event

theorem program.transient_false (p : pred' α) : transient s p False :=
nondet.program.transient_false _

def program.transient_antimono (s : program) {p q p' q' : α → Prop}
  (hp : p' ⟹ p)
  (hq : q' ⟹ q)
: s.transient p q → s.transient p' q' :=
nondet.program.transient_antimono _ hp hq

end theorems

instance prog_is_system : unitb.system program :=
{ σ := _
, transient := _
, step := is_step
, init   := nondet.program.init ∘ program.nondet
, transient_false := program.transient_false
, transient_antimono := program.transient_antimono }

open unitb

lemma leads_to.nondet (s : program) {p q : pred' α}
   (h : leads_to s p q)
: leads_to s.nondet p q :=
begin
  apply leads_to.subst _ s s.nondet _ _ h,
  { intros p q H, apply H },
  { intros p q H, apply H },
end

-- instance {α} [sched lbl] : system_sem (program lbl) :=
instance : unitb.system_sem program :=
  { (_ : unitb.system program) with
    ex := program.ex
  , safety := λ s, unitb.system_sem.safety s.nondet
  , inhabited := λ s, unitb.system_sem.inhabited s.nondet
  , init_sem := λ s, @unitb.system_sem.init_sem _ _ s.nondet
  , transient_sem := λ s, @unitb.system_sem.transient_sem _ _ s.nondet }

open unitb

theorem transient_rule {s : program} {p q : pred' α} (ev : option s.lbl)
   (EN : p ⋀ -q ⟹ s.coarse_sch_of ev)
   (FLW : (p ⋀ -q ⋀ s.coarse_sch_of ev) ↦ s.fine_sch_of ev ⋁ q in s)
   (NEG : ∀ σ σ', ¬ q σ → s.step_of ev σ σ' → q σ')
   (STABLE : unless (program.nondet s) p q)
: p ↦ q in s.nondet :=
@nondet.ensure_rule _ s.nondet p q ev EN (leads_to.nondet _ FLW) NEG STABLE

end schedules

end schedules


import Lean

@[simp] theorem ex1 (x : Nat) : 2 * x = x + x :=
  sorry

@[simp] theorem ex2 (xs : List α) : xs ++ [] = xs :=
  sorry

@[simp] theorem ex3 (xs ys zs : List α) : (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
  sorry

@[simp] theorem ex5 (p : Prop) : p ∨ True :=
  sorry

@[simp] theorem ex4 (xs : List α) : ¬(x :: xs = []) :=
  sorry

@[simp] theorem ex6 (p q : Prop) : p ∨ q ↔ q ∨ p:=
  sorry

@[simp high] theorem ex7 [Add α] (a b : α) : a + b = b + a :=
  sorry

@[simp↓] theorem ex8 [Add α] (p q : Prop) : (¬ (p ∧ q)) = (¬p ∨ ¬q) :=
  sorry

axiom aux {α} (f : List α → List α) (xs ys : List α) : f (xs ++ ys) ++ [] = f (xs ++ ys)

open Lean
open Lean.Meta

def tst1 : MetaM Unit := do
  let lemmas  ← Meta.getSimpLemmas
  trace[Meta.debug] "{lemmas.pre}\n-----\n{lemmas.post}"

set_option trace.Meta.debug true in
#eval tst1

def tst2 : MetaM Unit := do
  let c ← getConstInfo `aux
  forallTelescopeReducing c.type fun xs type => do
    match type.eq? with
    | none => throwError "unexpected"
    | some (_, lhs, _) =>
      trace[Meta.debug] "lhs: {lhs}"
      let s ← Meta.getSimpLemmas
      let m ← s.post.getMatch lhs
      trace[Meta.debug] "result: {m}"
      assert! m.any fun s => s.name? == `ex2

set_option trace.Meta.debug true in
#eval tst2


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton

Type of continuous maps and the compact-open topology on them.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.subset_properties
import Mathlib.topology.continuous_map
import Mathlib.tactic.tidy
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

namespace continuous_map

def compact_open.gen {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    (s : set α) (u : set β) : set (continuous_map α β) :=
  set_of fun (f : continuous_map α β) => ⇑f '' s ⊆ u

-- The compact-open topology on the space of continuous maps α → β.

protected instance compact_open {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] : topological_space (continuous_map α β) :=
  topological_space.generate_from
    (set_of
      fun (m : set (continuous_map α β)) =>
        ∃ (s : set α), ∃ (hs : is_compact s), ∃ (u : set β), ∃ (hu : is_open u), m = sorry)

def induced {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α] [topological_space β]
    [topological_space γ] {g : β → γ} (hg : continuous g) (f : continuous_map α β) :
    continuous_map α γ :=
  mk (g ∘ ⇑f)

/-- C(α, -) is a functor. -/
theorem continuous_induced {α : Type u_1} {β : Type u_2} {γ : Type u_3} [topological_space α]
    [topological_space β] [topological_space γ] {g : β → γ} (hg : continuous g) :
    continuous (induced hg) :=
  sorry

def ev (α : Type u_1) (β : Type u_2) [topological_space α] [topological_space β]
    (p : continuous_map α β × α) : β :=
  coe_fn (prod.fst p) (prod.snd p)

-- The evaluation map C(α, β) × α → β is continuous if α is locally compact.

theorem continuous_ev {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    [locally_compact_space α] : continuous (ev α β) :=
  sorry

def coev (α : Type u_1) (β : Type u_2) [topological_space α] [topological_space β] (b : β) :
    continuous_map α (β × α) :=
  mk fun (a : α) => (b, a)

theorem image_coev {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {y : β}
    (s : set α) : ⇑(coev α β y) '' s = set.prod (singleton y) s :=
  sorry

-- The coevaluation map β → C(α, β × α) is continuous (always).

theorem continuous_coev {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] :
    continuous (coev α β) :=
  sorry

end Mathlib