From afb2e8db724829aa0ab2f2b8568060d42057e3e2 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Mon, 27 Apr 2026 13:55:51 -0600 Subject: [PATCH 01/34] feat: add concrete category boilerplate command --- .../CategoryTheory/MkConcreteCategory.lean | 108 ++++++++++++++++ MathlibTest/MkConcreteCategory.lean | 117 ++++++++++++++++++ 2 files changed, 225 insertions(+) create mode 100644 Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean create mode 100644 MathlibTest/MkConcreteCategory.lean diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean new file mode 100644 index 00000000000000..d7596d40f5a1d6 --- /dev/null +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Dagur Asgeirsson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dagur Asgeirsson +-/ +module + +public import Mathlib.CategoryTheory.ConcreteCategory.Basic + +/-! +# The `mk_concrete_category` command + +`mk_concrete_category C FC id comp` generates the standard initial boilerplate for a concrete +category whose morphisms are modeled by a bundled function type `FC`. + +It creates a wrapper morphism structure `Hom`, a `Category` instance, a `ConcreteCategory` +instance, the public constructor `ofHom`, the projection abbreviation `Hom.hom`, and the basic +`dsimp`/round-trip lemmas. +-/ + +open Lean Elab Command +open CategoryTheory + +namespace Mathlib.Tactic.CategoryTheory + +/-- +`mk_concrete_category C FC id comp` generates the standard boilerplate for a concrete category on +`C` whose underlying bundled hom type is `FC : C → C → Type*`, with identities given by `id` and +composition given by `comp`. + +The command is intended to be used in the namespace of `C`. It creates declarations named `Hom`, +`Hom.hom`, `ofHom`, `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. +-/ +syntax (name := mkConcreteCategory) "mk_concrete_category " term:max ppSpace term:max ppSpace + term:max ppSpace term:max : command + +/-- Elaborator for `mk_concrete_category`. -/ +@[command_elab mkConcreteCategory] +public meta def elabMkConcreteCategory : CommandElab := fun stx => do + let `(mk_concrete_category $cat $FC $idTerm $compTerm) := stx + | throwUnsupportedSyntax + + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + /-- The type of morphisms in this concrete category. -/ + @[ext] + structure Hom (X Y : $cat) where + private mk :: + /-- The underlying bundled morphism. -/ + hom' : ($FC:term) X Y) + + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance : CategoryTheory.Category $cat where + Hom X Y := Hom X Y + id X := ⟨($idTerm:term) X⟩ + comp f g := ⟨($compTerm:term) f.hom' g.hom'⟩) + + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance : CategoryTheory.ConcreteCategory $cat $FC where + hom := Hom.hom' + ofHom := Hom.mk + id_apply := by intros; rfl + comp_apply := by intros; rfl) + + elabCommand <| ← set_option hygiene false in `(command| + /-- Turn a categorical morphism back into its underlying bundled morphism. -/ + abbrev Hom.hom {X Y : $cat} (f : Hom X Y) := + CategoryTheory.ConcreteCategory.hom (C := $cat) f) + + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom {X Y : $cat} (f : CategoryTheory.ToHom X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + + elabCommand <| ← set_option hygiene false in `(command| + /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ + def Hom.Simps.hom (X Y : $cat) (f : Hom X Y) := + f.hom) + + elabCommand <| ← set_option hygiene false in `(command| + initialize_simps_projections Hom (hom' → hom)) + + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($idTerm) X) := + rfl) + + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($compTerm) f.hom g.hom) := + rfl) + + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom {X Y : $cat} (f : CategoryTheory.ToHom X Y) : (ofHom f).hom = f := + rfl) + + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : ofHom f.hom = f := + rfl) + +end Mathlib.Tactic.CategoryTheory diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean new file mode 100644 index 00000000000000..417fc1e516e57f --- /dev/null +++ b/MathlibTest/MkConcreteCategory.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Dagur Asgeirsson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dagur Asgeirsson +-/ +module + +import Mathlib.Tactic.CategoryTheory.MkConcreteCategory + +open CategoryTheory + +universe u + +/-- A tiny test category whose morphisms are wrappers around functions. -/ +structure TestCat where + /-- The underlying type. -/ + α : Type u + +namespace TestCat + +@[ext] +structure Fun (X Y : TestCat.{u}) where + toFun : X.α → Y.α + +instance (X Y : TestCat.{u}) : FunLike (Fun X Y) X.α Y.α where + coe := Fun.toFun + coe_injective' _ _ _ := by aesop + +protected def Fun.id (X : TestCat.{u}) : Fun X X where + toFun := id + +protected def Fun.comp {X Y Z : TestCat.{u}} (f : Fun X Y) (g : Fun Y Z) : Fun X Z where + toFun := g.toFun ∘ f.toFun + +mk_concrete_category TestCat Fun (Fun.id) (Fun.comp) + +/-- info: TestCat.Hom.{u_1} (X Y : TestCat) : Type u_1 -/ +#guard_msgs in +#check Hom + +/-- info: TestCat.Hom.mk.{u_1} {X Y : TestCat} (hom' : X.Fun Y) : X.Hom Y -/ +#guard_msgs in +#check Hom.mk + +/-- info: TestCat.Hom.hom'.{u_1} {X Y : TestCat} (self : X.Hom Y) : X.Fun Y -/ +#guard_msgs in +#check Hom.hom' + +/-- info: TestCat.Hom.ext.{u_1} {X Y : TestCat} {x y : X.Hom Y} (hom' : x.hom' = y.hom') : x = y -/ +#guard_msgs in +#check Hom.ext + +/-- info: inferInstance : Category.{u_1, u_1 + 1} TestCat -/ +#guard_msgs in +#check (inferInstance : Category TestCat) + +/-- info: inferInstance : ConcreteCategory TestCat Fun -/ +#guard_msgs in +#check (inferInstance : ConcreteCategory TestCat Fun) + +/-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X.Hom Y) : X.Fun Y -/ +#guard_msgs in +#check Hom.hom + +/-- info: TestCat.ofHom.{u_1} {X Y : TestCat} (f : ToHom X Y) : X ⟶ Y -/ +#guard_msgs in +#check ofHom + +/-- info: TestCat.Hom.Simps.hom.{u_1} (X Y : TestCat) (f : X.Hom Y) : X.Fun Y -/ +#guard_msgs in +#check Hom.Simps.hom + +/-- info: TestCat.hom_id.{u_1} {X : TestCat} : Hom.hom (𝟙 X) = Fun.id X -/ +#guard_msgs in +#check hom_id + +/-- info: TestCat.hom_comp.{u_1} {X Y Z : TestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.hom (f ≫ g) = (Hom.hom f).comp (Hom.hom g) -/ +#guard_msgs in +#check hom_comp + +/-- info: TestCat.hom_ofHom.{u_1} {X Y : TestCat} (f : ToHom X Y) : Hom.hom (ofHom f) = f -/ +#guard_msgs in +#check hom_ofHom + +/-- info: TestCat.ofHom_hom.{u_1} {X Y : TestCat} (f : X ⟶ Y) : ofHom (Hom.hom f) = f -/ +#guard_msgs in +#check ofHom_hom + +example : Category TestCat := inferInstance + +example : ConcreteCategory TestCat Fun := inferInstance + +example {X Y : TestCat} (f : X ⟶ Y) : f.hom = ConcreteCategory.hom f := rfl + +example {X Y : TestCat} (f : Fun X Y) : (ofHom f).hom = f := by + dsimp + +example {X Y : TestCat} (f : X ⟶ Y) : ofHom f.hom = f := by + dsimp + +example {X : TestCat} : (𝟙 X : X ⟶ X).hom = Fun.id X := by + dsimp + +example {X Y Z : TestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = Fun.comp f.hom g.hom := by + dsimp + +example {X Y : TestCat} (f g : X ⟶ Y) (h : f.hom = g.hom) : f = g := + Hom.ext h + +example {X Y : TestCat} (f g : X ⟶ Y) (h : ∀ x, f x = g x) : f = g := by + cat_disch + +example {X Y : TestCat} (f : Fun X Y) (x : X.α) : ofHom f x = f x := by + dsimp + +end TestCat From b000f35388c7e8b19cc3873d0c7920f7d8b18dbb Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Mon, 27 Apr 2026 13:58:53 -0600 Subject: [PATCH 02/34] . --- MathlibTest/MkConcreteCategory.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean index 417fc1e516e57f..60f39ad6ae1c31 100644 --- a/MathlibTest/MkConcreteCategory.lean +++ b/MathlibTest/MkConcreteCategory.lean @@ -115,3 +115,4 @@ example {X Y : TestCat} (f : Fun X Y) (x : X.α) : ofHom f x = f x := by dsimp end TestCat +-- From df320f01e4ed6d804b900fd9a5367919f12f55f8 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Mon, 27 Apr 2026 14:00:04 -0600 Subject: [PATCH 03/34] mk_all --- Mathlib.lean | 1 + Mathlib/Tactic.lean | 1 + MathlibTest/MkConcreteCategory.lean | 1 - 3 files changed, 2 insertions(+), 1 deletion(-) diff --git a/Mathlib.lean b/Mathlib.lean index 0b76f62837981e..1d80a483e01966 100644 --- a/Mathlib.lean +++ b/Mathlib.lean @@ -6986,6 +6986,7 @@ public import Mathlib.Tactic.CategoryTheory.Coherence.Normalize public import Mathlib.Tactic.CategoryTheory.Coherence.PureCoherence public import Mathlib.Tactic.CategoryTheory.Elementwise public import Mathlib.Tactic.CategoryTheory.IsoReassoc +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory public import Mathlib.Tactic.CategoryTheory.Monoidal.Basic public import Mathlib.Tactic.CategoryTheory.Monoidal.Datatypes public import Mathlib.Tactic.CategoryTheory.Monoidal.Normalize diff --git a/Mathlib/Tactic.lean b/Mathlib/Tactic.lean index d66d693ade5d3d..44e29f901000b6 100644 --- a/Mathlib/Tactic.lean +++ b/Mathlib/Tactic.lean @@ -39,6 +39,7 @@ public import Mathlib.Tactic.CategoryTheory.Coherence.Normalize public import Mathlib.Tactic.CategoryTheory.Coherence.PureCoherence public import Mathlib.Tactic.CategoryTheory.Elementwise public import Mathlib.Tactic.CategoryTheory.IsoReassoc +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory public import Mathlib.Tactic.CategoryTheory.Monoidal.Basic public import Mathlib.Tactic.CategoryTheory.Monoidal.Datatypes public import Mathlib.Tactic.CategoryTheory.Monoidal.Normalize diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean index 60f39ad6ae1c31..417fc1e516e57f 100644 --- a/MathlibTest/MkConcreteCategory.lean +++ b/MathlibTest/MkConcreteCategory.lean @@ -115,4 +115,3 @@ example {X Y : TestCat} (f : Fun X Y) (x : X.α) : ofHom f x = f x := by dsimp end TestCat --- From 0f87956dd572af88e838d087dd9e472b7a1d9f17 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:14:26 -0600 Subject: [PATCH 04/34] feat: improve mk_concrete_category --- .../CategoryTheory/MkConcreteCategory.lean | 370 +++++++++++++++--- MathlibTest/MkConcreteCategory.lean | 239 ++++++++++- 2 files changed, 545 insertions(+), 64 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index d7596d40f5a1d6..e18bbca21e7f37 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -6,6 +6,7 @@ Authors: Dagur Asgeirsson module public import Mathlib.CategoryTheory.ConcreteCategory.Basic +public import Mathlib.Tactic.ToAdditive /-! # The `mk_concrete_category` command @@ -31,78 +32,337 @@ composition given by `comp`. The command is intended to be used in the namespace of `C`. It creates declarations named `Hom`, `Hom.hom`, `ofHom`, `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. -/ -syntax (name := mkConcreteCategory) "mk_concrete_category " term:max ppSpace term:max ppSpace - term:max ppSpace term:max : command +syntax (name := mkConcreteCategory) declModifiers "mk_concrete_category " term:max ppSpace + term:max ppSpace term:max ppSpace term:max : command + +syntax (name := mkConcreteCategoryWithAdditive) declModifiers + "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace + "to_additive " term:max ppSpace term:max ppSpace term:max ppSpace term:max : command + +/-- Whether a syntax tree contains a `to_additive` attribute. -/ +private meta partial def hasToAdditiveAttr (stx : Syntax) : Bool := + match stx with + | .ident _ _ n _ => n == `to_additive + | .atom _ val => val == "to_additive" + | .node _ k args => k == ``Mathlib.Tactic.ToAdditive.to_additive || args.any hasToAdditiveAttr + | _ => false + +/-- The first identifier occurring in a syntax tree. -/ +private meta partial def firstIdent? (stx : Syntax) : Option Name := + if stx.isIdent then some stx.getId else + match stx with + | .node _ _ args => args.findSome? firstIdent? + | _ => none + +/-- The explicit target of a `@[to_additive Target]` attribute, if present. -/ +private meta partial def toAdditiveTarget? (stx : Syntax) : Option Name := + if stx.isOfKind ``Mathlib.Tactic.ToAdditive.to_additive then + firstIdent? stx + else + match stx with + | .node _ _ args => args.findSome? toAdditiveTarget? + | _ => none + +/-- If a term is just an application to placeholder dots, return the applied function. + +This lets the command recover from common inputs such as `LinearMap.id ·` and +`LinearMap.comp · ·`, where the dots are intended as a mnemonic for the arguments supplied by the +command rather than as Lean's usual placeholder abstraction. +-/ +private meta partial def stripPlaceholderApplication (stx : Syntax) : TSyntax `term := + let stx := + if stx.isOfKind ``Lean.Parser.Term.paren then + stripPlaceholderApplication stx[1] + else if stx.isOfKind ``Lean.Parser.Term.app then + let args := stx[1].getArgs + if args.all (·.isOfKind ``Lean.Parser.Term.cdot) then + ⟨stx[0]⟩ + else + ⟨stx⟩ + else + ⟨stx⟩ + stx + +/-- Elaborator for the `mk_concrete_category ... to_additive ...` form. -/ +@[command_elab mkConcreteCategoryWithAdditive] +public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => do + let `($_mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm to_additive + $addCat $addFC $addIdTerm $addCompTerm) := stx + | throwUnsupportedSyntax + let catNs ← + if cat.raw.isIdent then pure <| mkIdent cat.raw.getId + else throwErrorAt cat "category must be an identifier in the `to_additive` form" + let addCatNs ← + if addCat.raw.isIdent then pure <| mkIdent addCat.raw.getId + else throwErrorAt addCat "additive category must be an identifier" + elabCommand <| ← set_option hygiene false in `(command| namespace $addCatNs:ident) + elabCommand <| ← set_option hygiene false in + `(command| mk_concrete_category $addCat $addFC $addIdTerm $addCompTerm) + elabCommand <| ← set_option hygiene false in `(command| end $addCatNs:ident) + elabCommand <| ← set_option hygiene false in `(command| namespace $catNs:ident) + elabCommand <| ← set_option hygiene false in + `(command| mk_concrete_category $cat $FC $idTerm $compTerm) + elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) /-- Elaborator for `mk_concrete_category`. -/ @[command_elab mkConcreteCategory] public meta def elabMkConcreteCategory : CommandElab := fun stx => do - let `(mk_concrete_category $cat $FC $idTerm $compTerm) := stx + let `($mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm) := stx | throwUnsupportedSyntax + let useToAdditive := hasToAdditiveAttr mods + let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) + let idBase : TSyntax `term := stripPlaceholderApplication idTerm + let compBase : TSyntax `term := stripPlaceholderApplication compTerm - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - /-- The type of morphisms in this concrete category. -/ - @[ext] - structure Hom (X Y : $cat) where - private mk :: - /-- The underlying bundled morphism. -/ - hom' : ($FC:term) X Y) + if useToAdditive then + match addHom? with + | some addHom => + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + /-- The type of morphisms in this concrete category. -/ + @[to_additive $addHom:ident, ext] + structure Hom (X Y : $cat) where + private mk :: + /-- The underlying bundled morphism. -/ + hom' : (($FC : $cat → $cat → Type _)) X Y) + | none => + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + /-- The type of morphisms in this concrete category. -/ + @[to_additive, ext] + structure Hom (X Y : $cat) where + private mk :: + /-- The underlying bundled morphism. -/ + hom' : (($FC : $cat → $cat → Type _)) X Y) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + /-- The type of morphisms in this concrete category. -/ + @[ext] + structure Hom (X Y : $cat) where + private mk :: + /-- The underlying bundled morphism. -/ + hom' : (($FC : $cat → $cat → Type _)) X Y) - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance : CategoryTheory.Category $cat where - Hom X Y := Hom X Y - id X := ⟨($idTerm:term) X⟩ - comp f g := ⟨($compTerm:term) f.hom' g.hom'⟩) + if idBase.raw == idTerm.raw then + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + else + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance : CategoryTheory.ConcreteCategory $cat $FC where - hom := Hom.hom' - ofHom := Hom.mk - id_apply := by intros; rfl - comp_apply := by intros; rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instConcreteCategory : + CategoryTheory.ConcreteCategory $cat (($FC : $cat → $cat → Type _)) where + hom := fun f => Hom.hom' f + ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f + id_apply := by intros; rfl + comp_apply := by intros; rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instConcreteCategory : + CategoryTheory.ConcreteCategory $cat (($FC : $cat → $cat → Type _)) where + hom := fun f => Hom.hom' f + ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f + id_apply := by intros; rfl + comp_apply := by intros; rfl) - elabCommand <| ← set_option hygiene false in `(command| - /-- Turn a categorical morphism back into its underlying bundled morphism. -/ - abbrev Hom.hom {X Y : $cat} (f : Hom X Y) := - CategoryTheory.ConcreteCategory.hom (C := $cat) f) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + /-- Turn a categorical morphism back into its underlying bundled morphism. -/ + @[to_additive] + abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + CategoryTheory.ConcreteCategory.hom (C := $cat) f) + else + elabCommand <| ← set_option hygiene false in `(command| + /-- Turn a categorical morphism back into its underlying bundled morphism. -/ + abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + CategoryTheory.ConcreteCategory.hom (C := $cat) f) - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - abbrev ofHom {X Y : $cat} (f : CategoryTheory.ToHom X Y) : X ⟶ Y := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + @[to_additive] + abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + else + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) - elabCommand <| ← set_option hygiene false in `(command| - /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ - def Hom.Simps.hom (X Y : $cat) (f : Hom X Y) := - f.hom) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ + @[to_additive] + def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : + (($FC : $cat → $cat → Type _)) X Y := + f.hom') + else + elabCommand <| ← set_option hygiene false in `(command| + /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ + def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : + (($FC : $cat → $cat → Type _)) X Y := + f.hom') elabCommand <| ← set_option hygiene false in `(command| initialize_simps_projections Hom (hom' → hom)) + match addHom? with + | some addHom => + elabCommand <| ← set_option hygiene false in `(command| + initialize_simps_projections $addHom:ident (hom' → hom)) + | none => pure () - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($idTerm) X) := - rfl) + if idBase.raw == idTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := + rfl) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by + first | exact ($(idBase)) X | exact $(idBase)) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by + first | exact ($(idBase)) X | exact $(idBase)) := + rfl) - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($compTerm) f.hom g.hom) := - rfl) + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) f.hom g.hom) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) f.hom g.hom) := + rfl) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) g.hom f.hom) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) g.hom f.hom) := + rfl) - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_ofHom {X Y : $cat} (f : CategoryTheory.ToHom X Y) : (ofHom f).hom = f := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : ofHom f.hom = f := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := + rfl) end Mathlib.Tactic.CategoryTheory diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean index 417fc1e516e57f..d212781ca35f88 100644 --- a/MathlibTest/MkConcreteCategory.lean +++ b/MathlibTest/MkConcreteCategory.lean @@ -6,10 +6,14 @@ Authors: Dagur Asgeirsson module import Mathlib.Tactic.CategoryTheory.MkConcreteCategory +public import Mathlib.Algebra.Category.ModuleCat.Semi +public import Mathlib.Algebra.Category.Grp.Preadditive +public import Mathlib.CategoryTheory.Linear.Basic +public import Mathlib.CategoryTheory.Preadditive.AdditiveFunctor open CategoryTheory -universe u +universe v u /-- A tiny test category whose morphisms are wrappers around functions. -/ structure TestCat where @@ -32,7 +36,7 @@ protected def Fun.id (X : TestCat.{u}) : Fun X X where protected def Fun.comp {X Y Z : TestCat.{u}} (f : Fun X Y) (g : Fun Y Z) : Fun X Z where toFun := g.toFun ∘ f.toFun -mk_concrete_category TestCat Fun (Fun.id) (Fun.comp) +mk_concrete_category TestCat Fun Fun.id Fun.comp /-- info: TestCat.Hom.{u_1} (X Y : TestCat) : Type u_1 -/ #guard_msgs in @@ -50,19 +54,19 @@ mk_concrete_category TestCat Fun (Fun.id) (Fun.comp) #guard_msgs in #check Hom.ext -/-- info: inferInstance : Category.{u_1, u_1 + 1} TestCat -/ +/-- info: TestCat.instCategory.{u_1} : Category.{u_1, u_1 + 1} TestCat -/ #guard_msgs in -#check (inferInstance : Category TestCat) +#check TestCat.instCategory -/-- info: inferInstance : ConcreteCategory TestCat Fun -/ +/-- info: TestCat.instConcreteCategory.{u_1} : ConcreteCategory TestCat Fun -/ #guard_msgs in -#check (inferInstance : ConcreteCategory TestCat Fun) +#check TestCat.instConcreteCategory /-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X.Hom Y) : X.Fun Y -/ #guard_msgs in #check Hom.hom -/-- info: TestCat.ofHom.{u_1} {X Y : TestCat} (f : ToHom X Y) : X ⟶ Y -/ +/-- info: TestCat.ofHom.{u_1} {X Y : TestCat} (f : X.Fun Y) : X ⟶ Y -/ #guard_msgs in #check ofHom @@ -78,11 +82,11 @@ mk_concrete_category TestCat Fun (Fun.id) (Fun.comp) #guard_msgs in #check hom_comp -/-- info: TestCat.hom_ofHom.{u_1} {X Y : TestCat} (f : ToHom X Y) : Hom.hom (ofHom f) = f -/ +/-- info: TestCat.hom_ofHom.{u_1} {X Y : TestCat} (f : X.Fun Y) : Hom.hom (ConcreteCategory.ofHom f) = f -/ #guard_msgs in #check hom_ofHom -/-- info: TestCat.ofHom_hom.{u_1} {X Y : TestCat} (f : X ⟶ Y) : ofHom (Hom.hom f) = f -/ +/-- info: TestCat.ofHom_hom.{u_1} {X Y : TestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f -/ #guard_msgs in #check ofHom_hom @@ -115,3 +119,220 @@ example {X Y : TestCat} (f : Fun X Y) (x : X.α) : ofHom f x = f x := by dsimp end TestCat + +variable (R : Type u) [Ring R] + +structure ModuleTestCat where + carrier : Type v + [isAddCommGroup : AddCommGroup carrier] + [isModule : Module R carrier] + +attribute [instance] ModuleTestCat.isAddCommGroup +attribute [instance 1100] ModuleTestCat.isModule + +namespace ModuleTestCat + +instance : CoeSort (ModuleTestCat.{v} R) (Type v) := + ⟨ModuleTestCat.carrier⟩ + +attribute [coe] ModuleTestCat.carrier + +variable {R} in +mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) + +/-- info: ModuleTestCat.Hom.{u, u_1, u_2} {R : Type u} [Ring R] (X : ModuleTestCat R) (Y : ModuleTestCat R) : Type (max u_1 u_2) -/ +#guard_msgs in +#check Hom + +/-- +info: ModuleTestCat.Hom.mk.{u, u_1, u_2} {R : Type u} [Ring R] {X : ModuleTestCat R} {Y : ModuleTestCat R} + (hom' : ↑X →ₗ[R] ↑Y) : X.Hom Y +-/ +#guard_msgs in +#check Hom.mk + +/-- +info: ModuleTestCat.Hom.hom'.{u, u_1, u_2} {R : Type u} [Ring R] {X : ModuleTestCat R} {Y : ModuleTestCat R} + (self : X.Hom Y) : ↑X →ₗ[R] ↑Y +-/ +#guard_msgs in +#check Hom.hom' + +/-- +info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : ModuleTestCat R} {Y : ModuleTestCat R} + {x y : X.Hom Y} (hom' : x.hom' = y.hom') : x = y +-/ +#guard_msgs in +#check Hom.ext + +/-- info: ModuleTestCat.instCategory.{u, u_1} {R : Type u} [Ring R] : Category.{u_1, max u (u_1 + 1)} (ModuleTestCat R) -/ +#guard_msgs in +#check ModuleTestCat.instCategory + +/-- info: ModuleTestCat.instConcreteCategory.{u, u_1} {R : Type u} [Ring R] : + ConcreteCategory (ModuleTestCat R) fun x1 x2 => ↑x1 →ₗ[R] ↑x2 -/ +#guard_msgs in +#check ModuleTestCat.instConcreteCategory + +/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X.Hom Y) : ↑X →ₗ[R] ↑Y -/ +#guard_msgs in +#check Hom.hom + +/-- info: ModuleTestCat.ofHom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : ↑X →ₗ[R] ↑Y) : X ⟶ Y -/ +#guard_msgs in +#check ofHom + +/-- +info: ModuleTestCat.Hom.Simps.hom.{u, u_1, u_2} {R : Type u} [Ring R] (X : ModuleTestCat R) (Y : ModuleTestCat R) + (f : X.Hom Y) : (fun x1 x2 => ↑x1 →ₗ[R] ↑x2) X Y +-/ +#guard_msgs in +#check Hom.Simps.hom + +/-- info: ModuleTestCat.hom_id.{u, u_1} {R : Type u} [Ring R] {X : ModuleTestCat R} : Hom.hom (𝟙 X) = LinearMap.id -/ +#guard_msgs in +#check hom_id + +/-- info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f -/ +#guard_msgs in +#check hom_comp + +/-- info: ModuleTestCat.hom_ofHom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : ↑X →ₗ[R] ↑Y) : + Hom.hom (ConcreteCategory.ofHom f) = f -/ +#guard_msgs in +#check hom_ofHom + +/-- info: ModuleTestCat.ofHom_hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : + ConcreteCategory.ofHom (Hom.hom f) = f -/ +#guard_msgs in +#check ofHom_hom + +example : Category (ModuleTestCat.{v} R) := inferInstance + +example : ConcreteCategory (ModuleTestCat.{v} R) (fun X Y => X →ₗ[R] Y) := inferInstance + +example {X Y : ModuleTestCat.{v} R} (f : X ⟶ Y) : f.hom = ConcreteCategory.hom f := rfl + +example {X Y : ModuleTestCat.{v} R} (f : X →ₗ[R] Y) : (ofHom f).hom = f := by + dsimp + +example {X Y : ModuleTestCat.{v} R} (f : X ⟶ Y) : ofHom f.hom = f := by + dsimp + +example {X : ModuleTestCat.{v} R} : (𝟙 X : X ⟶ X).hom = LinearMap.id := by + dsimp + +example {X Y Z : ModuleTestCat.{v} R} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = LinearMap.comp g.hom f.hom := by + dsimp + +example {X Y : ModuleTestCat.{v} R} (f g : X ⟶ Y) (h : f.hom = g.hom) : f = g := + Hom.ext h + +example {X Y : ModuleTestCat.{v} R} (f g : X ⟶ Y) (h : ∀ x, f x = g x) : f = g := by + cat_disch + +example {X Y : ModuleTestCat.{v} R} (f : X →ₗ[R] Y) (x : X) : ofHom f x = f x := by + dsimp + +end ModuleTestCat + +/-- Additive test category for the `to_additive` form of `mk_concrete_category`. -/ +structure AdditiveTestCat where + /-- The underlying type. -/ + carrier : Type u + [str : AddMonoid carrier] + +/-- Multiplicative test category for the `to_additive` form of `mk_concrete_category`. -/ +@[to_additive AdditiveTestCat] +structure MultiplicativeTestCat where + /-- The underlying type. -/ + carrier : Type u + [str : Monoid carrier] + +attribute [instance] AdditiveTestCat.str MultiplicativeTestCat.str + +namespace MultiplicativeTestCat + +@[to_additive instCoeSortAdditiveTestCat] +instance instCoeSort : CoeSort MultiplicativeTestCat (Type u) := + ⟨MultiplicativeTestCat.carrier⟩ + +end MultiplicativeTestCat + +attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier + +@[to_additive AdditiveTestCat] +mk_concrete_category MultiplicativeTestCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + to_additive AdditiveTestCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + +namespace MultiplicativeTestCat + +/-- info: MultiplicativeTestCat.Hom.{u_1, u_2} (X : MultiplicativeTestCat) (Y : MultiplicativeTestCat) : Type (max u_1 u_2) -/ +#guard_msgs in +#check Hom + +/-- info: MultiplicativeTestCat.instCategory.{u_1} : Category.{u_1, u_1 + 1} MultiplicativeTestCat -/ +#guard_msgs in +#check MultiplicativeTestCat.instCategory + +/-- info: MultiplicativeTestCat.instConcreteCategory.{u_1} : ConcreteCategory MultiplicativeTestCat fun x1 x2 => ↑x1 →* ↑x2 -/ +#guard_msgs in +#check MultiplicativeTestCat.instConcreteCategory + +/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X.Hom Y) : ↑X →* ↑Y -/ +#guard_msgs in +#check Hom.hom + +/-- info: MultiplicativeTestCat.ofHom.{u_1} {X Y : MultiplicativeTestCat} (f : ↑X →* ↑Y) : X ⟶ Y -/ +#guard_msgs in +#check ofHom + +example : Category MultiplicativeTestCat := inferInstance + +example : ConcreteCategory MultiplicativeTestCat (fun X Y => X →* Y) := inferInstance + +example {X Y : MultiplicativeTestCat} (f : X →* Y) : (ofHom f).hom = f := by + dsimp + +example {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = MonoidHom.comp g.hom f.hom := by + dsimp + +end MultiplicativeTestCat + +namespace AdditiveTestCat + +/-- info: AdditiveTestCat.Hom.{u_1, u_2} (X : AdditiveTestCat) (Y : AdditiveTestCat) : Type (max u_1 u_2) -/ +#guard_msgs in +#check Hom + +/-- info: AdditiveTestCat.instCategory.{u_1} : Category.{u_1, u_1 + 1} AdditiveTestCat -/ +#guard_msgs in +#check AdditiveTestCat.instCategory + +/-- info: AdditiveTestCat.instConcreteCategory.{u_1} : ConcreteCategory AdditiveTestCat fun x1 x2 => ↑x1 →+ ↑x2 -/ +#guard_msgs in +#check AdditiveTestCat.instConcreteCategory + +/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X.Hom Y) : ↑X →+ ↑Y -/ +#guard_msgs in +#check Hom.hom + +/-- info: AdditiveTestCat.ofHom.{u_1} {X Y : AdditiveTestCat} (f : ↑X →+ ↑Y) : X ⟶ Y -/ +#guard_msgs in +#check ofHom + +example : Category AdditiveTestCat := inferInstance + +example : ConcreteCategory AdditiveTestCat (fun X Y => X →+ Y) := inferInstance + +example {X Y : AdditiveTestCat} (f : X →+ Y) : (ofHom f).hom = f := by + dsimp + +example {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = AddMonoidHom.comp g.hom f.hom := by + dsimp + +end AdditiveTestCat From e76d40a1be2b39622df234d27e797b59903f8171 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:19:29 -0600 Subject: [PATCH 05/34] Apply suggestion from @dagurtomas --- MathlibTest/MkConcreteCategory.lean | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean index d212781ca35f88..6aa88483dd9169 100644 --- a/MathlibTest/MkConcreteCategory.lean +++ b/MathlibTest/MkConcreteCategory.lean @@ -6,10 +6,8 @@ Authors: Dagur Asgeirsson module import Mathlib.Tactic.CategoryTheory.MkConcreteCategory -public import Mathlib.Algebra.Category.ModuleCat.Semi -public import Mathlib.Algebra.Category.Grp.Preadditive -public import Mathlib.CategoryTheory.Linear.Basic -public import Mathlib.CategoryTheory.Preadditive.AdditiveFunctor +public import Mathlib.Algebra.Module.LinearMap.Defs +public import Mathlib.CategoryTheory.ConcreteCategory.Basic open CategoryTheory From 2a007f194d99d18372f6c3f0e840ee94927207cf Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:37:58 -0600 Subject: [PATCH 06/34] feat: support custom ofHom signatures --- .../CategoryTheory/MkConcreteCategory.lean | 100 +++++++++++++++--- MathlibTest/MkConcreteCategory.lean | 27 ++++- 2 files changed, 106 insertions(+), 21 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index e18bbca21e7f37..5c2fb3f13643b2 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -35,10 +35,23 @@ The command is intended to be used in the namespace of `C`. It creates declarati syntax (name := mkConcreteCategory) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max : command +syntax (name := mkConcreteCategoryWithOfHom) declModifiers "mk_concrete_category " term:max ppSpace + term:max ppSpace term:max ppSpace term:max ppSpace "with_of_hom" + (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace "from " term:max ppSpace + "to " term:max : command + syntax (name := mkConcreteCategoryWithAdditive) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace "to_additive " term:max ppSpace term:max ppSpace term:max ppSpace term:max : command +syntax (name := mkConcreteCategoryWithOfHomAndAdditive) (priority := high) declModifiers + "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace + "with_of_hom" (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace + "from " term:max ppSpace "to " term:max ppSpace + "to_additive " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace + "with_of_hom" (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace + "from " term:max ppSpace "to " term:max : command + /-- Whether a syntax tree contains a `to_additive` attribute. -/ private meta partial def hasToAdditiveAttr (stx : Syntax) : Bool := match stx with @@ -104,11 +117,12 @@ public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => d `(command| mk_concrete_category $cat $FC $idTerm $compTerm) elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) -/-- Elaborator for `mk_concrete_category`. -/ -@[command_elab mkConcreteCategory] -public meta def elabMkConcreteCategory : CommandElab := fun stx => do - let `($mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm) := stx - | throwUnsupportedSyntax +/-- Core implementation of `mk_concrete_category`. -/ +private abbrev CustomOfHomData := + TSyntaxArray `Lean.Parser.Term.bracketedBinder × TSyntax `term × TSyntax `term × TSyntax `term + +private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compTerm : TSyntax `term) + (customOfHom? : Option CustomOfHomData) : CommandElabM Unit := do let useToAdditive := hasToAdditiveAttr mods let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) let idBase : TSyntax `term := stripPlaceholderApplication idTerm @@ -253,17 +267,33 @@ public meta def elabMkConcreteCategory : CommandElab := fun stx => do abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := CategoryTheory.ConcreteCategory.hom (C := $cat) f) - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - @[to_additive] - abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) - else - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + match customOfHom? with + | some (binders, homTy, source, target) => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + @[to_additive] + abbrev ofHom $binders:bracketedBinder* + (f : ($homTy)) : $source ⟶ $target := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + else + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom $binders:bracketedBinder* + (f : ($homTy)) : $source ⟶ $target := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + | none => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + @[to_additive] + abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + else + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @@ -365,4 +395,42 @@ public meta def elabMkConcreteCategory : CommandElab := fun stx => do CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := rfl) +/-- Elaborator for `mk_concrete_category`. -/ +@[command_elab mkConcreteCategory] +public meta def elabMkConcreteCategory : CommandElab := fun stx => do + let `($mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm) := stx + | throwUnsupportedSyntax + elabMkConcreteCategoryCore mods cat FC idTerm compTerm none + +/-- Elaborator for the `mk_concrete_category ... with_of_hom ...` form. -/ +@[command_elab mkConcreteCategoryWithOfHom] +public meta def elabMkConcreteCategoryWithOfHom : CommandElab := fun stx => do + let `($mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm with_of_hom + $binders:bracketedBinder* hom_type $homTy from $source to $target) := stx + | throwUnsupportedSyntax + elabMkConcreteCategoryCore mods cat FC idTerm compTerm (some (binders, homTy, source, target)) + +/-- Elaborator for the `mk_concrete_category ... with_of_hom ... to_additive ...` form. -/ +@[command_elab mkConcreteCategoryWithOfHomAndAdditive] +public meta def elabMkConcreteCategoryWithOfHomAndAdditive : CommandElab := fun stx => do + let `($_mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm with_of_hom + $binders:bracketedBinder* hom_type $homTy from $source to $target to_additive + $addCat $addFC $addIdTerm $addCompTerm with_of_hom $addBinders:bracketedBinder* + hom_type $addHomTy from $addSource to $addTarget) := stx + | throwUnsupportedSyntax + let catNs ← + if cat.raw.isIdent then pure <| mkIdent cat.raw.getId + else throwErrorAt cat "category must be an identifier in the `to_additive` form" + let addCatNs ← + if addCat.raw.isIdent then pure <| mkIdent addCat.raw.getId + else throwErrorAt addCat "additive category must be an identifier" + elabCommand <| ← set_option hygiene false in `(command| namespace $addCatNs:ident) + elabMkConcreteCategoryCore Syntax.missing addCat addFC addIdTerm addCompTerm + (some (addBinders, addHomTy, addSource, addTarget)) + elabCommand <| ← set_option hygiene false in `(command| end $addCatNs:ident) + elabCommand <| ← set_option hygiene false in `(command| namespace $catNs:ident) + elabMkConcreteCategoryCore Syntax.missing cat FC idTerm compTerm + (some (binders, homTy, source, target)) + elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) + end Mathlib.Tactic.CategoryTheory diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/MkConcreteCategory.lean index 6aa88483dd9169..b118b3a84da158 100644 --- a/MathlibTest/MkConcreteCategory.lean +++ b/MathlibTest/MkConcreteCategory.lean @@ -130,6 +130,11 @@ attribute [instance 1100] ModuleTestCat.isModule namespace ModuleTestCat +/-- Construct a bundled `ModuleTestCat` from the underlying type and typeclass. -/ +abbrev of (R : Type u) [Ring R] (M : Type v) [AddCommGroup M] [Module R M] : + ModuleTestCat R := + ⟨M⟩ + instance : CoeSort (ModuleTestCat.{v} R) (Type v) := ⟨ModuleTestCat.carrier⟩ @@ -137,6 +142,8 @@ attribute [coe] ModuleTestCat.carrier variable {R} in mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) + with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] + hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) /-- info: ModuleTestCat.Hom.{u, u_1, u_2} {R : Type u} [Ring R] (X : ModuleTestCat R) (Y : ModuleTestCat R) : Type (max u_1 u_2) -/ #guard_msgs in @@ -176,7 +183,8 @@ info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : M #guard_msgs in #check Hom.hom -/-- info: ModuleTestCat.ofHom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : ↑X →ₗ[R] ↑Y) : X ⟶ Y -/ +/-- info: ModuleTestCat.ofHom.{v, u} {R : Type u} [Ring R] {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] + [Module R Y] (f : X →ₗ[R] Y) : of R X ⟶ of R Y -/ #guard_msgs in #check ofHom @@ -253,6 +261,11 @@ attribute [instance] AdditiveTestCat.str MultiplicativeTestCat.str namespace MultiplicativeTestCat +/-- Construct a bundled `MultiplicativeTestCat` from the underlying type and typeclass. -/ +@[to_additive /-- Construct a bundled `AdditiveTestCat` from the underlying type and typeclass. -/] +abbrev of (M : Type u) [Monoid M] : MultiplicativeTestCat := + ⟨M⟩ + @[to_additive instCoeSortAdditiveTestCat] instance instCoeSort : CoeSort MultiplicativeTestCat (Type u) := ⟨MultiplicativeTestCat.carrier⟩ @@ -263,7 +276,11 @@ attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier @[to_additive AdditiveTestCat] mk_concrete_category MultiplicativeTestCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] + hom_type (X →* Y) from (MultiplicativeTestCat.of X) to (MultiplicativeTestCat.of Y) to_additive AdditiveTestCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] + hom_type (X →+ Y) from (AdditiveTestCat.of X) to (AdditiveTestCat.of Y) namespace MultiplicativeTestCat @@ -283,7 +300,7 @@ namespace MultiplicativeTestCat #guard_msgs in #check Hom.hom -/-- info: MultiplicativeTestCat.ofHom.{u_1} {X Y : MultiplicativeTestCat} (f : ↑X →* ↑Y) : X ⟶ Y -/ +/-- info: MultiplicativeTestCat.ofHom.{u} {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : of X ⟶ of Y -/ #guard_msgs in #check ofHom @@ -291,7 +308,7 @@ example : Category MultiplicativeTestCat := inferInstance example : ConcreteCategory MultiplicativeTestCat (fun X Y => X →* Y) := inferInstance -example {X Y : MultiplicativeTestCat} (f : X →* Y) : (ofHom f).hom = f := by +example {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : (ofHom f).hom = f := by dsimp example {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : @@ -318,7 +335,7 @@ namespace AdditiveTestCat #guard_msgs in #check Hom.hom -/-- info: AdditiveTestCat.ofHom.{u_1} {X Y : AdditiveTestCat} (f : ↑X →+ ↑Y) : X ⟶ Y -/ +/-- info: AdditiveTestCat.ofHom.{u} {X Y : Type u} [AddMonoid X] [AddMonoid Y] (f : X →+ Y) : of X ⟶ of Y -/ #guard_msgs in #check ofHom @@ -326,7 +343,7 @@ example : Category AdditiveTestCat := inferInstance example : ConcreteCategory AdditiveTestCat (fun X Y => X →+ Y) := inferInstance -example {X Y : AdditiveTestCat} (f : X →+ Y) : (ofHom f).hom = f := by +example {X Y : Type u} [AddMonoid X] [AddMonoid Y] (f : X →+ Y) : (ofHom f).hom = f := by dsimp example {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : From 8a7712e45ce5e3571ea2894c27eb0aa0732f9b1e Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:42:05 -0600 Subject: [PATCH 07/34] chore: document mk_concrete_category internals --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 5c2fb3f13643b2..92c9cb68251ee8 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -117,10 +117,12 @@ public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => d `(command| mk_concrete_category $cat $FC $idTerm $compTerm) elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) -/-- Core implementation of `mk_concrete_category`. -/ +/-- Data for a custom generated `ofHom` declaration: binders, source hom type, source +object, and target object. -/ private abbrev CustomOfHomData := TSyntaxArray `Lean.Parser.Term.bracketedBinder × TSyntax `term × TSyntax `term × TSyntax `term +/-- Core implementation of `mk_concrete_category`. -/ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compTerm : TSyntax `term) (customOfHom? : Option CustomOfHomData) : CommandElabM Unit := do let useToAdditive := hasToAdditiveAttr mods From decde10792d1e2177bdc9c5ac10e88b6b6b09156 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:45:57 -0600 Subject: [PATCH 08/34] chore: move mk_concrete_category tests --- MathlibTest/{ => CategoryTheory}/MkConcreteCategory.lean | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename MathlibTest/{ => CategoryTheory}/MkConcreteCategory.lean (100%) diff --git a/MathlibTest/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean similarity index 100% rename from MathlibTest/MkConcreteCategory.lean rename to MathlibTest/CategoryTheory/MkConcreteCategory.lean From 88635b4545eda2a70740b2f27fdf0e67b7ca6d38 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:46:14 -0600 Subject: [PATCH 09/34] chore: document mk_concrete_category syntax variants --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 92c9cb68251ee8..5407998d479508 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -35,15 +35,18 @@ The command is intended to be used in the namespace of `C`. It creates declarati syntax (name := mkConcreteCategory) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max : command +/-- Variant of `mk_concrete_category` with a custom generated `ofHom` signature. -/ syntax (name := mkConcreteCategoryWithOfHom) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace "with_of_hom" (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace "from " term:max ppSpace "to " term:max : command +/-- Variant of `mk_concrete_category` generating multiplicative and additive categories together. -/ syntax (name := mkConcreteCategoryWithAdditive) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace "to_additive " term:max ppSpace term:max ppSpace term:max ppSpace term:max : command +/-- Variant of `mk_concrete_category` combining the custom `ofHom` and additive forms. -/ syntax (name := mkConcreteCategoryWithOfHomAndAdditive) (priority := high) declModifiers "mk_concrete_category " term:max ppSpace term:max ppSpace term:max ppSpace term:max ppSpace "with_of_hom" (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace From 6c4e4ba2104e8aaff58d342c21906ebe8795a4fc Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:52:50 -0600 Subject: [PATCH 10/34] cleanup --- .../CategoryTheory/MkConcreteCategory.lean | 174 ++++++------------ 1 file changed, 53 insertions(+), 121 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 5407998d479508..df0056d025a880 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -132,6 +132,23 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) let idBase : TSyntax `term := stripPlaceholderApplication idTerm let compBase : TSyntax `term := stripPlaceholderApplication compTerm + let idWasStripped := idBase.raw != idTerm.raw + let compWasStripped := compBase.raw != compTerm.raw + let idDef : TSyntax `term ← + if idWasStripped then + `(term| by first | exact ($(idBase)) X | exact $(idBase)) + else + `(term| ($(idBase)) X) + let compDef : TSyntax `term ← + if compWasStripped then + `(term| ($(compBase)) g.hom' f.hom') + else + `(term| ($(compBase)) f.hom' g.hom') + let homCompRhs : TSyntax `term ← + if compWasStripped then + `(term| ($(compBase)) g.hom f.hom) + else + `(term| ($(compBase)) f.hom g.hom) if useToAdditive then match addHom? with @@ -163,80 +180,23 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT /-- The underlying bundled morphism. -/ hom' : (($FC : $cat → $cat → Type _)) X Y) - if idBase.raw == idTerm.raw then - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) $idDef + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) $compDef) else - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) $idDef + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) $compDef) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @@ -322,57 +282,29 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT initialize_simps_projections $addHom:ident (hom' → hom)) | none => pure () - if idBase.raw == idTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = $idDef := + rfl) else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by - first | exact ($(idBase)) X | exact $(idBase)) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by - first | exact ($(idBase)) X | exact $(idBase)) := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = $idDef := + rfl) - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) f.hom g.hom) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) f.hom g.hom) := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = $homCompRhs := + rfl) else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) g.hom f.hom) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) g.hom f.hom) := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = $homCompRhs := + rfl) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| From d751cb53097bb1c60827104ce65d75f1fe0278f0 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 14:53:29 -0600 Subject: [PATCH 11/34] -tiny --- MathlibTest/CategoryTheory/MkConcreteCategory.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index b118b3a84da158..43000d5c232b69 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -13,7 +13,7 @@ open CategoryTheory universe v u -/-- A tiny test category whose morphisms are wrappers around functions. -/ +/-- A test category whose morphisms are wrappers around functions. -/ structure TestCat where /-- The underlying type. -/ α : Type u From 8f8a7a8bde8cfcb8b848dd2f22d58f6d95c8b662 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 15:08:43 -0600 Subject: [PATCH 12/34] improve docs --- .../CategoryTheory/MkConcreteCategory.lean | 320 +++++++++++++----- 1 file changed, 236 insertions(+), 84 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index df0056d025a880..11b359ac3c3261 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -14,9 +14,48 @@ public import Mathlib.Tactic.ToAdditive `mk_concrete_category C FC id comp` generates the standard initial boilerplate for a concrete category whose morphisms are modeled by a bundled function type `FC`. -It creates a wrapper morphism structure `Hom`, a `Category` instance, a `ConcreteCategory` -instance, the public constructor `ofHom`, the projection abbreviation `Hom.hom`, and the basic -`dsimp`/round-trip lemmas. +The command is intended to be run in the namespace of the category it is defining. It creates a +wrapper morphism structure `Hom`, with field `Hom.hom'`, and uses it as the categorical morphism +type. It then creates: + +* `instCategory`, the `Category` instance whose identities and composition are induced by `id` and + `comp`; +* `instConcreteCategory`, the `ConcreteCategory C FC` instance; +* `Hom.hom`, an abbreviation for the `ConcreteCategory.hom` projection; +* `ofHom`, a public abbreviation for `ConcreteCategory.ofHom`; +* `Hom.Simps.hom`, so `simps` uses the concrete morphism projection; +* simp lemmas `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. + +For example, the plain command + +```lean +mk_concrete_category TestCat Fun Fun.id Fun.comp +``` + +generates an API where `Hom.hom : X.Hom Y → X.Fun Y`, `ofHom : X.Fun Y → (X ⟶ Y)`, +`hom_id : Hom.hom (𝟙 X) = Fun.id X`, and +`hom_comp : Hom.hom (f ≫ g) = (Hom.hom f).comp (Hom.hom g)`. + +For bundled categories whose public constructor should take unbundled objects, `with_of_hom` +customizes only the generated `ofHom` signature. The underlying `ConcreteCategory.ofHom` lemma still +uses bundled objects. + +```lean +mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) + with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] + hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) +``` + +Here `ofHom` has type `(X →ₗ[R] Y) → (of R X ⟶ of R Y)`, while `hom_comp` states composition in the +order expected by `LinearMap.comp`: `Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f`. + +The explicit `to_additive` forms are for pairs of categories where the multiplicative and additive +versions should be generated at the same time. They take the multiplicative category data and the +corresponding additive category data in one command. The elaborator first enters the additive +namespace and generates the additive concrete category, then enters the multiplicative namespace and +generates the multiplicative one. This is useful for commands such as the test case generating both +`MultiplicativeTestCat` with homs `X →* Y` and `AdditiveTestCat` with homs `X →+ Y`, including their +matching `ofHom`, `hom_id`, and `hom_comp` declarations. -/ open Lean Elab Command @@ -24,6 +63,12 @@ open CategoryTheory namespace Mathlib.Tactic.CategoryTheory +/-! +The parser exposes four surface forms: the basic command, the same command with a custom `ofHom` +signature, a form that supplies multiplicative and additive category data together, and a combined +form with both `with_of_hom` and explicit additive data. +-/ + /-- `mk_concrete_category C FC id comp` generates the standard boilerplate for a concrete category on `C` whose underlying bundled hom type is `FC : C → C → Type*`, with identities given by `id` and @@ -55,6 +100,12 @@ syntax (name := mkConcreteCategoryWithOfHomAndAdditive) (priority := high) declM "with_of_hom" (ppSpace bracketedBinder)* ppSpace "hom_type " term:max ppSpace "from " term:max ppSpace "to " term:max : command +/-! +These helpers inspect raw syntax rather than elaborated terms. This command has to notice both +ordinary command modifiers such as `@[to_additive]` and placeholder applications such as +`LinearMap.comp · ·` before Lean elaborates them as inaccessible placeholder abstractions. +-/ + /-- Whether a syntax tree contains a `to_additive` attribute. -/ private meta partial def hasToAdditiveAttr (stx : Syntax) : Bool := match stx with @@ -99,32 +150,60 @@ private meta partial def stripPlaceholderApplication (stx : Syntax) : TSyntax `t ⟨stx⟩ stx +/-! +The explicit `to_additive` forms generate declarations by entering the target namespaces and +running the same core generator there. These helpers keep the namespace checks and open/close +commands in one place. +-/ + +/-- Turn a category term from a `to_additive` form into the namespace identifier to generate in. -/ +private meta def categoryNamespaceIdent (cat : TSyntax `term) (message : String) : + CommandElabM Ident := do + if cat.raw.isIdent then + pure <| mkIdent cat.raw.getId + else + throwErrorAt cat message + +/-- Elaborate commands inside a namespace generated by a `to_additive` form. -/ +private meta def elabInNamespace (ns : Ident) (body : CommandElabM Unit) : CommandElabM Unit := do + elabCommand <| ← set_option hygiene false in `(command| namespace $ns:ident) + body + elabCommand <| ← set_option hygiene false in `(command| end $ns:ident) + +/-! +For the explicit `to_additive` form without `with_of_hom`, generation is just two ordinary +`mk_concrete_category` commands: one in the additive namespace, then one in the multiplicative +namespace. The additive side is generated first so any later `to_additive` naming choices on the +multiplicative side can refer to existing additive declarations. +-/ + /-- Elaborator for the `mk_concrete_category ... to_additive ...` form. -/ @[command_elab mkConcreteCategoryWithAdditive] public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => do let `($_mods:declModifiers mk_concrete_category $cat $FC $idTerm $compTerm to_additive $addCat $addFC $addIdTerm $addCompTerm) := stx | throwUnsupportedSyntax - let catNs ← - if cat.raw.isIdent then pure <| mkIdent cat.raw.getId - else throwErrorAt cat "category must be an identifier in the `to_additive` form" - let addCatNs ← - if addCat.raw.isIdent then pure <| mkIdent addCat.raw.getId - else throwErrorAt addCat "additive category must be an identifier" - elabCommand <| ← set_option hygiene false in `(command| namespace $addCatNs:ident) - elabCommand <| ← set_option hygiene false in - `(command| mk_concrete_category $addCat $addFC $addIdTerm $addCompTerm) - elabCommand <| ← set_option hygiene false in `(command| end $addCatNs:ident) - elabCommand <| ← set_option hygiene false in `(command| namespace $catNs:ident) - elabCommand <| ← set_option hygiene false in - `(command| mk_concrete_category $cat $FC $idTerm $compTerm) - elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) + let catNs ← categoryNamespaceIdent cat "category must be an identifier in the `to_additive` form" + let addCatNs ← categoryNamespaceIdent addCat "additive category must be an identifier" + elabInNamespace addCatNs do + elabCommand <| ← set_option hygiene false in + `(command| mk_concrete_category $addCat $addFC $addIdTerm $addCompTerm) + elabInNamespace catNs do + elabCommand <| ← set_option hygiene false in + `(command| mk_concrete_category $cat $FC $idTerm $compTerm) /-- Data for a custom generated `ofHom` declaration: binders, source hom type, source object, and target object. -/ private abbrev CustomOfHomData := TSyntaxArray `Lean.Parser.Term.bracketedBinder × TSyntax `term × TSyntax `term × TSyntax `term +/-! +The core generator emits the declarations shared by all forms: `Hom`, the category and concrete +category instances, projections and constructors, simps support, and the round-trip lemmas. Most +branches below differ only in attributes or in how placeholder-dot input should be expanded, so the +generated syntax is kept explicit to make the resulting declarations predictable. +-/ + /-- Core implementation of `mk_concrete_category`. -/ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compTerm : TSyntax `term) (customOfHom? : Option CustomOfHomData) : CommandElabM Unit := do @@ -132,23 +211,6 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) let idBase : TSyntax `term := stripPlaceholderApplication idTerm let compBase : TSyntax `term := stripPlaceholderApplication compTerm - let idWasStripped := idBase.raw != idTerm.raw - let compWasStripped := compBase.raw != compTerm.raw - let idDef : TSyntax `term ← - if idWasStripped then - `(term| by first | exact ($(idBase)) X | exact $(idBase)) - else - `(term| ($(idBase)) X) - let compDef : TSyntax `term ← - if compWasStripped then - `(term| ($(compBase)) g.hom' f.hom') - else - `(term| ($(compBase)) f.hom' g.hom') - let homCompRhs : TSyntax `term ← - if compWasStripped then - `(term| ($(compBase)) g.hom f.hom) - else - `(term| ($(compBase)) f.hom g.hom) if useToAdditive then match addHom? with @@ -180,23 +242,83 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT /-- The underlying bundled morphism. -/ hom' : (($FC : $cat → $cat → Type _)) X Y) - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) $idDef - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) $compDef) + -- Keep these branches close to the generated syntax. When a placeholder application was + -- stripped, the dots are mnemonic arguments supplied by this command. For composition, this is + -- also where `LinearMap.comp · ·` and similar APIs get the generated arguments in API order. + if idBase.raw == idTerm.raw then + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) $idDef - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) $compDef) + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) + else + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + else + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @@ -282,29 +404,59 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT initialize_simps_projections $addHom:ident (hom' → hom)) | none => pure () - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = $idDef := - rfl) + -- These lemmas mirror the same placeholder-sensitive choices used in the `Category` instance + -- above. Keeping the right-hand sides explicit makes the generated statements stable. + if idBase.raw == idTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := + rfl) else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = $idDef := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by + first | exact ($(idBase)) X | exact $(idBase)) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by + first | exact ($(idBase)) X | exact $(idBase)) := + rfl) - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = $homCompRhs := - rfl) + if compBase.raw == compTerm.raw then + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) f.hom g.hom) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) f.hom g.hom) := + rfl) else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = $homCompRhs := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) g.hom f.hom) := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($(compBase)) g.hom f.hom) := + rfl) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @@ -332,6 +484,12 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := rfl) +/-! +The remaining elaborators parse their surface syntax and delegate to the core generator. The +combined `with_of_hom`/`to_additive` form calls the core generator directly for each namespace +because each side has its own custom `ofHom` binders and source/target terms. +-/ + /-- Elaborator for `mk_concrete_category`. -/ @[command_elab mkConcreteCategory] public meta def elabMkConcreteCategory : CommandElab := fun stx => do @@ -355,19 +513,13 @@ public meta def elabMkConcreteCategoryWithOfHomAndAdditive : CommandElab := fun $addCat $addFC $addIdTerm $addCompTerm with_of_hom $addBinders:bracketedBinder* hom_type $addHomTy from $addSource to $addTarget) := stx | throwUnsupportedSyntax - let catNs ← - if cat.raw.isIdent then pure <| mkIdent cat.raw.getId - else throwErrorAt cat "category must be an identifier in the `to_additive` form" - let addCatNs ← - if addCat.raw.isIdent then pure <| mkIdent addCat.raw.getId - else throwErrorAt addCat "additive category must be an identifier" - elabCommand <| ← set_option hygiene false in `(command| namespace $addCatNs:ident) - elabMkConcreteCategoryCore Syntax.missing addCat addFC addIdTerm addCompTerm - (some (addBinders, addHomTy, addSource, addTarget)) - elabCommand <| ← set_option hygiene false in `(command| end $addCatNs:ident) - elabCommand <| ← set_option hygiene false in `(command| namespace $catNs:ident) - elabMkConcreteCategoryCore Syntax.missing cat FC idTerm compTerm - (some (binders, homTy, source, target)) - elabCommand <| ← set_option hygiene false in `(command| end $catNs:ident) + let catNs ← categoryNamespaceIdent cat "category must be an identifier in the `to_additive` form" + let addCatNs ← categoryNamespaceIdent addCat "additive category must be an identifier" + elabInNamespace addCatNs do + elabMkConcreteCategoryCore Syntax.missing addCat addFC addIdTerm addCompTerm + (some (addBinders, addHomTy, addSource, addTarget)) + elabInNamespace catNs do + elabMkConcreteCategoryCore Syntax.missing cat FC idTerm compTerm + (some (binders, homTy, source, target)) end Mathlib.Tactic.CategoryTheory From c589728c7ed85ab20c02f7815873850e4c2ac365 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 16:14:36 -0600 Subject: [PATCH 13/34] feat(CategoryTheory): start using mk_concrete_cat --- Mathlib/Algebra/Category/BoolRing.lean | 39 +--- Mathlib/Algebra/Category/Grp/Basic.lean | 142 ++---------- Mathlib/Algebra/Category/ModuleCat/Basic.lean | 68 ++---- Mathlib/Algebra/Category/ModuleCat/Semi.lean | 99 +++------ Mathlib/Algebra/Category/MonCat/Basic.lean | 134 ++--------- Mathlib/Algebra/Category/Ring/Basic.lean | 210 ++---------------- Mathlib/Algebra/Category/Semigrp/Basic.lean | 135 ++--------- .../CategoryTheory/MkConcreteCategory.lean | 25 ++- Mathlib/Topology/Category/TopCat/Basic.lean | 49 +--- .../CategoryTheory/MkConcreteCategory.lean | 8 +- 10 files changed, 143 insertions(+), 766 deletions(-) diff --git a/Mathlib/Algebra/Category/BoolRing.lean b/Mathlib/Algebra/Category/BoolRing.lean index 65a667b67ab649..efe3586887e8af 100644 --- a/Mathlib/Algebra/Category/BoolRing.lean +++ b/Mathlib/Algebra/Category/BoolRing.lean @@ -8,6 +8,7 @@ module public import Mathlib.Algebra.Category.Ring.Basic public import Mathlib.Algebra.Ring.BooleanRing public import Mathlib.Order.Category.BoolAlg +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of Boolean rings @@ -51,39 +52,13 @@ theorem coe_of (α : Type*) [BooleanRing α] : ↥(of α) = α := instance : Inhabited BoolRing := ⟨of PUnit⟩ -variable {R} in -set_option backward.privateInPublic true in -/-- The type of morphisms in `BoolRing`. -/ -@[ext] -structure Hom (R S : BoolRing) where - private mk :: - /-- The underlying ring hom. -/ - hom' : R →+* S - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category BoolRing where - Hom R S := Hom R S - id R := ⟨RingHom.id R⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory BoolRing (· →+* ·) where - hom f := f.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `BoolRing` back into a `RingHom`. -/ -abbrev Hom.hom {X Y : BoolRing} (f : Hom X Y) := - ConcreteCategory.hom (C := BoolRing) f - -/-- Typecheck a `RingHom` as a morphism in `BoolRing`. -/ -abbrev ofHom {R S : Type u} [BooleanRing R] [BooleanRing S] (f : R →+* S) : of R ⟶ of S := - ConcreteCategory.ofHom f +mk_concrete_category BoolRing (· →+* ·) (RingHom.id ·) (RingHom.comp · ·) + with_of_hom {R S : Type u} [BooleanRing R] [BooleanRing S] + hom_type (R →+* S) from (of R) to (of S) @[ext] lemma hom_ext {R S : BoolRing} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := - Hom.ext hf + ConcreteCategory.hom_ext f g <| RingHom.congr_fun hf instance hasForgetToCommRing : HasForget₂ BoolRing CommRingCat where forget₂ := @@ -95,8 +70,8 @@ set_option backward.privateInPublic.warn false in /-- Constructs an isomorphism of Boolean rings from a ring isomorphism between them. -/ @[simps] def Iso.mk {α β : BoolRing.{u}} (e : α ≃+* β) : α ≅ β where - hom := ⟨e⟩ - inv := ⟨e.symm⟩ + hom := ofHom e + inv := ofHom e.symm hom_inv_id := by ext; exact e.symm_apply_apply _ inv_hom_id := by ext; exact e.apply_symm_apply _ diff --git a/Mathlib/Algebra/Category/Grp/Basic.lean b/Mathlib/Algebra/Category/Grp/Basic.lean index f9134582995abc..cbacfddd7712c4 100644 --- a/Mathlib/Algebra/Category/Grp/Basic.lean +++ b/Mathlib/Algebra/Category/Grp/Basic.lean @@ -9,6 +9,7 @@ public import Mathlib.Algebra.Category.MonCat.Basic public import Mathlib.Algebra.Group.End public import Mathlib.CategoryTheory.Endomorphism public import Mathlib.Data.Int.Cast.Lemmas +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for Group, AddGroup, CommGroup, and AddCommGroup. @@ -60,56 +61,15 @@ abbrev of (M : Type u) [Group M] : GrpCat := ⟨M⟩ end GrpCat -/-- The type of morphisms in `AddGrpCat R`. -/ -@[ext] -structure AddGrpCat.Hom (A B : AddGrpCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `GrpCat R`. -/ -@[to_additive, ext] -structure GrpCat.Hom (A B : GrpCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →* B +mk_concrete_category GrpCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + with_of_hom {X Y : Type u} [Group X] [Group Y] + hom_type (X →* Y) from (GrpCat.of X) to (GrpCat.of Y) + to_additive AddGrpCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + with_of_hom {X Y : Type u} [AddGroup X] [AddGroup Y] + hom_type (X →+ Y) from (AddGrpCat.of X) to (AddGrpCat.of Y) namespace GrpCat -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category GrpCat.{u} where - Hom X Y := Hom X Y - id X := ⟨MonoidHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory GrpCat (· →* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `GrpCat` back into a `MonoidHom`. -/ -@[to_additive /-- Turn a morphism in `AddGrpCat` back into an `AddMonoidHom`. -/] -abbrev Hom.hom {X Y : GrpCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := GrpCat) f - -/-- Typecheck a `MonoidHom` as a morphism in `GrpCat`. -/ -@[to_additive /-- Typecheck an `AddMonoidHom` as a morphism in `AddGrpCat`. -/] -abbrev ofHom {X Y : Type u} [Group X] [Group Y] (f : X →* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := GrpCat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : GrpCat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddGrpCat.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -131,18 +91,11 @@ lemma ext {X Y : GrpCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := theorem coe_of (R : Type u) [Group R] : ↑(GrpCat.of R) = R := rfl -@[to_additive (attr := simp)] -lemma hom_id {X : GrpCat} : (𝟙 X : X ⟶ X).hom = MonoidHom.id X := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (X : GrpCat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : @@ -152,13 +105,6 @@ lemma comp_apply {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : lemma hom_ext {X Y : GrpCat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {R S : Type u} [Group R] [Group S] (f : R →* S) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {X Y : GrpCat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {X : Type u} [Group X] : ofHom (MonoidHom.id X) = 𝟙 (of X) := rfl @@ -277,56 +223,15 @@ abbrev of (M : Type u) [CommGroup M] : CommGrpCat := ⟨M⟩ end CommGrpCat -/-- The type of morphisms in `AddCommGrpCat R`. -/ -@[ext] -structure AddCommGrpCat.Hom (A B : AddCommGrpCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `CommGrpCat R`. -/ -@[to_additive, ext] -structure CommGrpCat.Hom (A B : CommGrpCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →* B +mk_concrete_category CommGrpCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + with_of_hom {X Y : Type u} [CommGroup X] [CommGroup Y] + hom_type (X →* Y) from (CommGrpCat.of X) to (CommGrpCat.of Y) + to_additive AddCommGrpCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + with_of_hom {X Y : Type u} [AddCommGroup X] [AddCommGroup Y] + hom_type (X →+ Y) from (AddCommGrpCat.of X) to (AddCommGrpCat.of Y) namespace CommGrpCat -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category CommGrpCat.{u} where - Hom X Y := Hom X Y - id X := ⟨MonoidHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory CommGrpCat (· →* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `CommGrpCat` back into a `MonoidHom`. -/ -@[to_additive /-- Turn a morphism in `AddCommGrpCat` back into an `AddMonoidHom`. -/] -abbrev Hom.hom {X Y : CommGrpCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := CommGrpCat) f - -/-- Typecheck a `MonoidHom` as a morphism in `CommGrpCat`. -/ -@[to_additive /-- Typecheck an `AddMonoidHom` as a morphism in `AddCommGrpCat`. -/] -abbrev ofHom {X Y : Type u} [CommGroup X] [CommGroup Y] (f : X →* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := CommGrpCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -@[to_additive /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/] -def Hom.Simps.hom (X Y : CommGrpCat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddCommGrpCat.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -352,18 +257,11 @@ instance : Inhabited CommGrpCat := theorem coe_of (R : Type u) [CommGroup R] : ↑(CommGrpCat.of R) = R := rfl -@[to_additive (attr := simp)] -lemma hom_id {X : CommGrpCat} : (𝟙 X : X ⟶ X).hom = MonoidHom.id X := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (X : CommGrpCat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {X Y T : CommGrpCat} (f : X ⟶ Y) (g : Y ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {X Y T : CommGrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : @@ -373,13 +271,6 @@ lemma comp_apply {X Y T : CommGrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : lemma hom_ext {X Y : CommGrpCat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {X Y : Type u} [CommGroup X] [CommGroup Y] (f : X →* Y) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {X Y : CommGrpCat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {X : Type u} [CommGroup X] : ofHom (MonoidHom.id X) = 𝟙 (of X) := rfl @@ -483,7 +374,7 @@ def asHom {G : AddCommGrpCat.{0}} (g : G) : AddCommGrpCat.of ℤ ⟶ G := ofHom (zmultiplesHom G g) theorem asHom_injective {G : AddCommGrpCat.{0}} : Function.Injective (@asHom G) := fun h k w => by - simpa using CategoryTheory.congr_fun w 1 + simpa [asHom] using ConcreteCategory.congr_hom w 1 @[ext] theorem int_hom_ext {G : AddCommGrpCat.{0}} (f g : AddCommGrpCat.of ℤ ⟶ G) @@ -494,7 +385,10 @@ theorem int_hom_ext {G : AddCommGrpCat.{0}} (f g : AddCommGrpCat.of ℤ ⟶ G) -- the forgetful functor is representable. theorem injective_of_mono {G H : AddCommGrpCat.{0}} (f : G ⟶ H) [Mono f] : Function.Injective f := fun g₁ g₂ h => by - have t0 : asHom g₁ ≫ f = asHom g₂ ≫ f := by cat_disch + have t0 : asHom g₁ ≫ f = asHom g₂ ≫ f := by + ext + change f ((asHom g₁) (1 : ℤ)) = f ((asHom g₂) (1 : ℤ)) + simp [asHom, h] have t1 : asHom g₁ = asHom g₂ := (cancel_mono _).1 t0 apply asHom_injective t1 diff --git a/Mathlib/Algebra/Category/ModuleCat/Basic.lean b/Mathlib/Algebra/Category/ModuleCat/Basic.lean index f7f850e3d730a6..a40df528c24d55 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Basic.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Basic.lean @@ -9,6 +9,7 @@ public import Mathlib.Algebra.Category.ModuleCat.Semi public import Mathlib.Algebra.Category.Grp.Preadditive public import Mathlib.CategoryTheory.Linear.Basic public import Mathlib.CategoryTheory.Preadditive.AdditiveFunctor +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of `R`-modules @@ -84,74 +85,35 @@ lemma coe_of (X : Type v) [Ring X] [Module R X] : (of R X : Type v) = X := example (X : Type v) [Ring X] [Module R X] : (of R X : Type v) = X := by with_reducible rfl example (M : ModuleCat.{v} R) : of R M = M := by with_reducible rfl -set_option backward.privateInPublic true in variable {R} in -/-- The type of morphisms in `ModuleCat R`. -/ -@[ext] -structure Hom (M N : ModuleCat.{v} R) where - private mk :: - /-- The underlying linear map. -/ - hom' : M →ₗ[R] N - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance moduleCategory : Category.{v, max (v + 1) u} (ModuleCat.{v} R) where - Hom M N := Hom M N - id _ := ⟨LinearMap.id⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (ModuleCat.{v} R) (· →ₗ[R] ·) where - hom := Hom.hom' - ofHom := Hom.mk +mk_concrete_category (ModuleCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) + with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] + hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) section variable {R} -/-- Turn a morphism in `ModuleCat` back into a `LinearMap`. -/ -abbrev Hom.hom {A B : ModuleCat.{v} R} (f : Hom A B) := - ConcreteCategory.hom (C := ModuleCat R) f - -/-- Typecheck a `LinearMap` as a morphism in `ModuleCat`. -/ -abbrev ofHom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] - (f : X →ₗ[R] Y) : of R X ⟶ of R Y := - ConcreteCategory.ofHom (C := ModuleCat R) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : ModuleCat.{v} R) (f : Hom A B) := - f.hom - -initialize_simps_projections Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {M : ModuleCat.{v} R} : (𝟙 M : M ⟶ M).hom = LinearMap.id := rfl - /- Provided for rewriting. -/ lemma id_apply (M : ModuleCat.{v} R) (x : M) : (𝟙 M : M ⟶ M) x = x := by simp -@[simp] -lemma hom_comp {M N O : ModuleCat.{v} R} (f : M ⟶ N) (g : N ⟶ O) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {M N O : ModuleCat.{v} R} (f : M ⟶ N) (g : N ⟶ O) (x : M) : (f ≫ g) x = g (f x) := by simp @[ext] lemma hom_ext {M N : ModuleCat.{v} R} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := - Hom.ext hf + ConcreteCategory.hom_ext f g <| LinearMap.congr_fun hf lemma hom_bijective {M N : ModuleCat.{v} R} : Function.Bijective (Hom.hom : (M ⟶ N) → (M →ₗ[R] N)) where - left f g h := by cases f; cases g; simpa using h - right f := ⟨⟨f⟩, rfl⟩ + left _ _ h := hom_ext h + right f := ⟨ofHom f, by simp [Hom.hom]⟩ /-- Convenience shortcut for `ModuleCat.hom_bijective.injective`. -/ lemma hom_injective {M N : ModuleCat.{v} R} : @@ -163,14 +125,6 @@ lemma hom_surjective {M N : ModuleCat.{v} R} : Function.Surjective (Hom.hom : (M ⟶ N) → (M →ₗ[R] N)) := hom_bijective.surjective -@[simp] -lemma hom_ofHom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] - [Module R Y] (f : X →ₗ[R] Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {M N : ModuleCat.{v} R} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {M : Type v} [AddCommGroup M] [Module R M] : ofHom LinearMap.id = 𝟙 (of R M) := rfl @@ -208,8 +162,12 @@ def equivalenceSemimoduleCat : ModuleCat.{v} R ≌ SemimoduleCat.{v} R where inverse := letI := Module.addCommMonoidToAddCommGroup { obj M := of R M map {M N} f := ofHom f.hom } - unitIso := NatIso.ofComponents fun _ ↦ { hom := ⟨.id⟩, inv := ⟨.id⟩ } - counitIso := NatIso.ofComponents fun _ ↦ { hom := ⟨.id⟩, inv := ⟨.id⟩ } + unitIso := NatIso.ofComponents fun _ ↦ + { hom := by refine ConcreteCategory.ofHom (C := ModuleCat R) ?_; exact LinearMap.id + inv := by refine ConcreteCategory.ofHom (C := ModuleCat R) ?_; exact LinearMap.id } + counitIso := NatIso.ofComponents fun _ ↦ + { hom := by refine ConcreteCategory.ofHom (C := SemimoduleCat R) ?_; exact LinearMap.id + inv := by refine ConcreteCategory.ofHom (C := SemimoduleCat R) ?_; exact LinearMap.id } end diff --git a/Mathlib/Algebra/Category/ModuleCat/Semi.lean b/Mathlib/Algebra/Category/ModuleCat/Semi.lean index 355ffbf4e7dfec..681676de711d33 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Semi.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Semi.lean @@ -12,6 +12,7 @@ public import Mathlib.Algebra.Module.Equiv.Basic public import Mathlib.Algebra.Module.PUnit public import Mathlib.CategoryTheory.Conj public import Mathlib.CategoryTheory.Limits.Shapes.ZeroMorphisms +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of `R`-modules @@ -83,68 +84,34 @@ example (X : Type v) [Semiring X] [Module R X] : (of R X : Type v) = X := by wit example (M : SemimoduleCat.{v} R) : of R M = M := by with_reducible rfl variable {R} in -/-- The type of morphisms in `SemimoduleCat R`. -/ -@[ext] -structure Hom (M N : SemimoduleCat.{v} R) where - mk :: - /-- The underlying linear map. -/ - hom' : M →ₗ[R] N - -instance moduleCategory : Category.{v, max (v + 1) u} (SemimoduleCat.{v} R) where - Hom M N := Hom M N - id _ := ⟨LinearMap.id⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -instance : ConcreteCategory (SemimoduleCat.{v} R) (· →ₗ[R] ·) where - hom := Hom.hom' - ofHom := Hom.mk +mk_concrete_category (SemimoduleCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) + with_of_hom {X Y : Type v} [AddCommMonoid X] [Module R X] [AddCommMonoid Y] [Module R Y] + hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) section variable {R} -/-- Turn a morphism in `SemimoduleCat` back into a `LinearMap`. -/ -abbrev Hom.hom {A B : SemimoduleCat.{v} R} (f : Hom A B) := - ConcreteCategory.hom (C := SemimoduleCat R) f - -/-- Typecheck a `LinearMap` as a morphism in `SemimoduleCat`. -/ -abbrev ofHom {X Y : Type v} [AddCommMonoid X] [Module R X] [AddCommMonoid Y] [Module R Y] - (f : X →ₗ[R] Y) : of R X ⟶ of R Y := - ConcreteCategory.ofHom (C := SemimoduleCat R) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : SemimoduleCat.{v} R) (f : Hom A B) := - f.hom - -initialize_simps_projections Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {M : SemimoduleCat.{v} R} : (𝟙 M : M ⟶ M).hom = LinearMap.id := rfl - /- Provided for rewriting. -/ lemma id_apply (M : SemimoduleCat.{v} R) (x : M) : (𝟙 M : M ⟶ M) x = x := by simp -@[simp] -lemma hom_comp {M N O : SemimoduleCat.{v} R} (f : M ⟶ N) (g : N ⟶ O) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {M N O : SemimoduleCat.{v} R} (f : M ⟶ N) (g : N ⟶ O) (x : M) : (f ≫ g) x = g (f x) := by simp @[ext] lemma hom_ext {M N : SemimoduleCat.{v} R} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := - Hom.ext hf + ConcreteCategory.hom_ext f g <| LinearMap.congr_fun hf lemma hom_bijective {M N : SemimoduleCat.{v} R} : Function.Bijective (Hom.hom : (M ⟶ N) → (M →ₗ[R] N)) where - left f g h := by cases f; cases g; simpa using h - right f := ⟨⟨f⟩, rfl⟩ + left _ _ h := hom_ext h + right f := ⟨ofHom f, by simp [Hom.hom]⟩ /-- Convenience shortcut for `SemimoduleCat.hom_bijective.injective`. -/ lemma hom_injective {M N : SemimoduleCat.{v} R} : @@ -156,14 +123,6 @@ lemma hom_surjective {M N : SemimoduleCat.{v} R} : Function.Surjective (Hom.hom : (M ⟶ N) → (M →ₗ[R] N)) := hom_bijective.surjective -@[simp] -lemma hom_ofHom {X Y : Type v} [AddCommMonoid X] [Module R X] [AddCommMonoid Y] - [Module R Y] (f : X →ₗ[R] Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {M N : SemimoduleCat.{v} R} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {M : Type v} [AddCommMonoid M] [Module R M] : ofHom LinearMap.id = 𝟙 (of R M) := rfl @@ -285,26 +244,32 @@ section AddCommMonoid variable {M N : SemimoduleCat.{v} R} instance : Add (M ⟶ N) where - add f g := ⟨f.hom + g.hom⟩ + add f g := ofHom (f.hom + g.hom) -@[simp] lemma hom_add (f g : M ⟶ N) : (f + g).hom = f.hom + g.hom := rfl +@[simp] lemma hom_add (f g : M ⟶ N) : (f + g).hom = f.hom + g.hom := by + change (ofHom (f.hom + g.hom)).hom = f.hom + g.hom + simp instance : Zero (M ⟶ N) where - zero := ⟨0⟩ + zero := ofHom 0 -@[simp] lemma hom_zero : (0 : M ⟶ N).hom = 0 := rfl +@[simp] lemma hom_zero : (0 : M ⟶ N).hom = 0 := by + change (ofHom (0 : M →ₗ[R] N)).hom = 0 + simp instance : SMul ℕ (M ⟶ N) where - smul n f := ⟨n • f.hom⟩ + smul n f := ofHom (n • f.hom) -@[simp] lemma hom_nsmul (n : ℕ) (f : M ⟶ N) : (n • f).hom = n • f.hom := rfl +@[simp] lemma hom_nsmul (n : ℕ) (f : M ⟶ N) : (n • f).hom = n • f.hom := by + change (ofHom (n • f.hom)).hom = n • f.hom + simp -- There is no `ℤ`-smul operation on a general semimodule! @[deprecated (since := "2026-01-06")] alias hom_zsmul := hom_nsmul instance : AddCommMonoid (M ⟶ N) := - Function.Injective.addCommMonoid Hom.hom hom_injective rfl (fun _ _ => rfl) (fun _ _ => rfl) + Function.Injective.addCommMonoid Hom.hom hom_injective hom_zero hom_add (fun f n => hom_nsmul n f) @[simp] lemma hom_sum {ι : Type*} (f : ι → (M ⟶ N)) (s : Finset ι) : (∑ i ∈ s, f i).hom = ∑ i ∈ s, (f i).hom := @@ -321,7 +286,7 @@ instance : HasZeroMorphisms (SemimoduleCat.{v} R) where @[simps!] def homAddEquiv : (M ⟶ N) ≃+ (M →ₗ[R] N) := { homEquiv with - map_add' := fun _ _ => rfl } + map_add' := hom_add } theorem subsingleton_of_isZero (h : IsZero M) : Subsingleton M := by refine subsingleton_of_forall_eq 0 (fun x ↦ ?_) @@ -344,9 +309,11 @@ variable {M N : SemimoduleCat.{v} R} variable {S : Type*} [Monoid S] [DistribMulAction S N] [SMulCommClass R S N] instance : SMul S (M ⟶ N) where - smul c f := ⟨c • f.hom⟩ + smul c f := ofHom (c • f.hom) -@[simp] lemma hom_smul (s : S) (f : M ⟶ N) : (s • f).hom = s • f.hom := rfl +@[simp] lemma hom_smul (s : S) (f : M ⟶ N) : (s • f).hom = s • f.hom := by + change (ofHom (s • f.hom)).hom = s • f.hom + simp end SMul @@ -358,13 +325,13 @@ instance Hom.instModule : Module S (M ⟶ N) := Function.Injective.module S { toFun := Hom.hom, map_zero' := hom_zero, map_add' := hom_add } hom_injective - (fun _ _ => rfl) + hom_smul /-- `SemimoduleCat.Hom.hom` bundled as a linear equivalence. -/ @[simps] def homLinearEquiv : (M ⟶ N) ≃ₗ[S] (M →ₗ[R] N) := { homAddEquiv with - map_smul' := fun _ _ => rfl } + map_smul' := hom_smul } end Module @@ -408,11 +375,11 @@ instance : Linear S (SemimoduleCat.{v} S) := SemimoduleCat.Algebra.instLinear -/ variable {X Y X' Y' : SemimoduleCat.{v} S} theorem Iso.homCongr_eq_arrowCongr (i : X ≅ X') (j : Y ≅ Y') (f : X ⟶ Y) : - Iso.homCongr i j f = ⟨LinearEquiv.arrowCongr i.toLinearEquivₛ j.toLinearEquivₛ f.hom⟩ := + Iso.homCongr i j f = ofHom (LinearEquiv.arrowCongr i.toLinearEquivₛ j.toLinearEquivₛ f.hom) := rfl theorem Iso.conj_eq_conj (i : X ≅ X') (f : End X) : - Iso.conj i f = ⟨LinearEquiv.conj i.toLinearEquivₛ f.hom⟩ := + Iso.conj i f = ofHom (LinearEquiv.conj i.toLinearEquivₛ f.hom) := rfl end @@ -455,10 +422,14 @@ def Hom.hom₂ {M N P : SemimoduleCat.{u} R} (f : M ⟶ (of R (N ⟶ P))) : M (f ≫ ofHom homLinearEquiv.toLinearMap).hom @[simp] lemma Hom.hom₂_ofHom₂ {M N P : SemimoduleCat.{u} R} (f : M →ₗ[R] N →ₗ[R] P) : - (ofHom₂ f).hom₂ = f := rfl + (ofHom₂ f).hom₂ = f := by + ext x y + simp [ofHom₂, Hom.hom₂] @[simp] lemma ofHom₂_hom₂ {M N P : SemimoduleCat.{u} R} (f : M ⟶ of R (N ⟶ P)) : - ofHom₂ f.hom₂ = f := rfl + ofHom₂ f.hom₂ = f := by + ext x y + simp [ofHom₂, Hom.hom₂] end SemimoduleCat diff --git a/Mathlib/Algebra/Category/MonCat/Basic.lean b/Mathlib/Algebra/Category/MonCat/Basic.lean index 63580ff226d2ff..b024a0e78802b4 100644 --- a/Mathlib/Algebra/Category/MonCat/Basic.lean +++ b/Mathlib/Algebra/Category/MonCat/Basic.lean @@ -10,6 +10,7 @@ public import Mathlib.Algebra.Group.TypeTags.Hom public import Mathlib.Algebra.Group.ULift public import Mathlib.CategoryTheory.ConcreteCategory.Forget public import Mathlib.CategoryTheory.Functor.ReflectsIso.Basic +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for `Monoid`, `AddMonoid`, `CommMonoid`, and `AddCommMonoid`. @@ -63,55 +64,15 @@ abbrev of (M : Type u) [Monoid M] : MonCat := ⟨M⟩ end MonCat -/-- The type of morphisms in `AddMonCat`. -/ -@[ext] -structure AddMonCat.Hom (A B : AddMonCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `MonCat`. -/ -@[to_additive, ext] -structure MonCat.Hom (A B : MonCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →* B +mk_concrete_category MonCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] + hom_type (X →* Y) from (MonCat.of X) to (MonCat.of Y) + to_additive AddMonCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] + hom_type (X →+ Y) from (AddMonCat.of X) to (AddMonCat.of Y) namespace MonCat -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category MonCat.{u} where - Hom X Y := Hom X Y - id X := ⟨MonoidHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory MonCat (· →* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `MonCat` back into a `MonoidHom`. -/ -@[to_additive /-- Turn a morphism in `AddMonCat` back into an `AddMonoidHom`. -/] -abbrev Hom.hom {X Y : MonCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := MonCat) f - -/-- Typecheck a `MonoidHom` as a morphism in `MonCat`. -/ -@[to_additive /-- Typecheck an `AddMonoidHom` as a morphism in `AddMonCat`. -/] -abbrev ofHom {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := MonCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : MonCat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddMonCat.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -134,18 +95,11 @@ lemma ext {X Y : MonCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (M : Type u) [Monoid M] : (MonCat.of M : Type u) = M := rfl -@[to_additive (attr := simp)] -lemma hom_id {M : MonCat} : (𝟙 M : M ⟶ M).hom = MonoidHom.id M := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (M : MonCat) (x : M) : (𝟙 M : M ⟶ M) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {M N T : MonCat} (f : M ⟶ N) (g : N ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {M N T : MonCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : @@ -155,13 +109,6 @@ lemma comp_apply {M N T : MonCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : lemma hom_ext {M N : MonCat} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {M N : Type u} [Monoid M] [Monoid N] (f : M →* N) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {M N : MonCat} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {M : Type u} [Monoid M] : ofHom (MonoidHom.id M) = 𝟙 (of M) := rfl @@ -249,56 +196,15 @@ abbrev of (M : Type u) [CommMonoid M] : CommMonCat := ⟨M⟩ end CommMonCat -/-- The type of morphisms in `AddCommMonCat`. -/ -@[ext] -structure AddCommMonCat.Hom (A B : AddCommMonCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `CommMonCat`. -/ -@[to_additive, ext] -structure CommMonCat.Hom (A B : CommMonCat.{u}) where - private mk :: - /-- The underlying monoid homomorphism. -/ - hom' : A →* B +mk_concrete_category CommMonCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) + with_of_hom {X Y : Type u} [CommMonoid X] [CommMonoid Y] + hom_type (X →* Y) from (CommMonCat.of X) to (CommMonCat.of Y) + to_additive AddCommMonCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + with_of_hom {X Y : Type u} [AddCommMonoid X] [AddCommMonoid Y] + hom_type (X →+ Y) from (AddCommMonCat.of X) to (AddCommMonCat.of Y) namespace CommMonCat -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category CommMonCat.{u} where - Hom X Y := Hom X Y - id X := ⟨MonoidHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory CommMonCat (· →* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `CommMonCat` back into a `MonoidHom`. -/ -@[to_additive /-- Turn a morphism in `AddCommMonCat` back into an `AddMonoidHom`. -/] -abbrev Hom.hom {X Y : CommMonCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := CommMonCat) f - -/-- Typecheck a `MonoidHom` as a morphism in `CommMonCat`. -/ -@[to_additive /-- Typecheck an `AddMonoidHom` as a morphism in `AddCommMonCat`. -/] -abbrev ofHom {X Y : Type u} [CommMonoid X] [CommMonoid Y] (f : X →* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := CommMonCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -@[to_additive /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/] -def Hom.Simps.hom (X Y : CommMonCat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddCommMonCat.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -315,18 +221,11 @@ lemma coe_comp {X Y Z : CommMonCat} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g : X lemma ext {X Y : CommMonCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := ConcreteCategory.hom_ext _ _ w -@[to_additive (attr := simp)] -lemma hom_id {M : CommMonCat} : (𝟙 M : M ⟶ M).hom = MonoidHom.id M := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (M : CommMonCat) (x : M) : (𝟙 M : M ⟶ M) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {M N T : CommMonCat} (f : M ⟶ N) (g : N ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {M N T : CommMonCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : @@ -336,13 +235,6 @@ lemma comp_apply {M N T : CommMonCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : lemma hom_ext {M N : CommMonCat} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {M N : Type u} [CommMonoid M] [CommMonoid N] (f : M →* N) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {M N : CommMonCat} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {M : Type u} [CommMonoid M] : ofHom (MonoidHom.id M) = 𝟙 (of M) := rfl diff --git a/Mathlib/Algebra/Category/Ring/Basic.lean b/Mathlib/Algebra/Category/Ring/Basic.lean index 026c44a5d74c06..788058ffe8496e 100644 --- a/Mathlib/Algebra/Category/Ring/Basic.lean +++ b/Mathlib/Algebra/Category/Ring/Basic.lean @@ -8,6 +8,7 @@ module public import Mathlib.Algebra.Category.Grp.Basic public import Mathlib.Algebra.Ring.Equiv public import Mathlib.Algebra.Ring.PUnit +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for `Semiring`, `Ring`, `CommSemiring`, and `CommRing`. @@ -63,57 +64,18 @@ lemma coe_of (R : Type u) [Semiring R] : (of R : Type u) = R := lemma of_carrier (R : SemiRingCat.{u}) : of R = R := rfl -set_option backward.privateInPublic true in -variable {R} in -/-- The type of morphisms in `SemiRingCat`. -/ -@[ext] -structure Hom (R S : SemiRingCat.{u}) where - private mk :: - /-- The underlying ring hom. -/ - hom' : R →+* S - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category SemiRingCat where - Hom R S := Hom R S - id R := ⟨RingHom.id R⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory.{u} SemiRingCat (fun R S => R →+* S) where - hom := Hom.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `SemiRingCat` back into a `RingHom`. -/ -abbrev Hom.hom {R S : SemiRingCat.{u}} (f : Hom R S) := - ConcreteCategory.hom (C := SemiRingCat) f - -/-- Typecheck a `RingHom` as a morphism in `SemiRingCat`. -/ -abbrev ofHom {R S : Type u} [Semiring R] [Semiring S] (f : R →+* S) : of R ⟶ of S := - ConcreteCategory.ofHom (C := SemiRingCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (R S : SemiRingCat) (f : Hom R S) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category SemiRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) + with_of_hom {R S : Type u} [Semiring R] [Semiring S] + hom_type (R →+* S) from (SemiRingCat.of R) to (SemiRingCat.of S) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {R : SemiRingCat} : (𝟙 R : R ⟶ R).hom = RingHom.id R := rfl - /- Provided for rewriting. -/ lemma id_apply (R : SemiRingCat) (r : R) : (𝟙 R : R ⟶ R) r = r := by simp -@[simp] -lemma hom_comp {R S T : SemiRingCat} (f : R ⟶ S) (g : S ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {R S T : SemiRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : (f ≫ g) r = g (f r) := by simp @@ -122,13 +84,6 @@ lemma comp_apply {R S T : SemiRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : lemma hom_ext {R S : SemiRingCat} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {R S : Type u} [Semiring R] [Semiring S] (f : R →+* S) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {R S : SemiRingCat} (f : R ⟶ S) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {R : Type u} [Semiring R] : ofHom (RingHom.id R) = 𝟙 (of R) := rfl @@ -229,57 +184,18 @@ lemma coe_of (R : Type u) [Ring R] : (of R : Type u) = R := lemma of_carrier (R : RingCat.{u}) : of R = R := rfl -set_option backward.privateInPublic true in -variable {R} in -/-- The type of morphisms in `RingCat`. -/ -@[ext] -structure Hom (R S : RingCat.{u}) where - private mk :: - /-- The underlying ring hom. -/ - hom' : R →+* S - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category RingCat where - Hom R S := Hom R S - id R := ⟨RingHom.id R⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory.{u} RingCat (fun R S => R →+* S) where - hom := Hom.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `RingCat` back into a `RingHom`. -/ -abbrev Hom.hom {R S : RingCat.{u}} (f : Hom R S) := - ConcreteCategory.hom (C := RingCat) f - -/-- Typecheck a `RingHom` as a morphism in `RingCat`. -/ -abbrev ofHom {R S : Type u} [Ring R] [Ring S] (f : R →+* S) : of R ⟶ of S := - ConcreteCategory.ofHom (C := RingCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (R S : RingCat) (f : Hom R S) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category RingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) + with_of_hom {R S : Type u} [Ring R] [Ring S] + hom_type (R →+* S) from (RingCat.of R) to (RingCat.of S) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {R : RingCat} : (𝟙 R : R ⟶ R).hom = RingHom.id R := rfl - /- Provided for rewriting. -/ lemma id_apply (R : RingCat) (r : R) : (𝟙 R : R ⟶ R) r = r := by simp -@[simp] -lemma hom_comp {R S T : RingCat} (f : R ⟶ S) (g : S ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {R S T : RingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : (f ≫ g) r = g (f r) := by simp @@ -288,13 +204,6 @@ lemma comp_apply {R S T : RingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : lemma hom_ext {R S : RingCat} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {R S : Type u} [Ring R] [Ring S] (f : R →+* S) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {R S : RingCat} (f : R ⟶ S) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {R : Type u} [Ring R] : ofHom (RingHom.id R) = 𝟙 (of R) := rfl @@ -404,57 +313,18 @@ lemma coe_of (R : Type u) [CommSemiring R] : (of R : Type u) = R := lemma of_carrier (R : CommSemiRingCat.{u}) : of R = R := rfl -set_option backward.privateInPublic true in -variable {R} in -/-- The type of morphisms in `CommSemiRingCat`. -/ -@[ext] -structure Hom (R S : CommSemiRingCat.{u}) where - private mk :: - /-- The underlying ring hom. -/ - hom' : R →+* S - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category CommSemiRingCat where - Hom R S := Hom R S - id R := ⟨RingHom.id R⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory.{u} CommSemiRingCat (fun R S => R →+* S) where - hom := Hom.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `CommSemiRingCat` back into a `RingHom`. -/ -abbrev Hom.hom {R S : CommSemiRingCat.{u}} (f : Hom R S) := - ConcreteCategory.hom (C := CommSemiRingCat) f - -/-- Typecheck a `RingHom` as a morphism in `CommSemiRingCat`. -/ -abbrev ofHom {R S : Type u} [CommSemiring R] [CommSemiring S] (f : R →+* S) : of R ⟶ of S := - ConcreteCategory.ofHom (C := CommSemiRingCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (R S : CommSemiRingCat) (f : Hom R S) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category CommSemiRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) + with_of_hom {R S : Type u} [CommSemiring R] [CommSemiring S] + hom_type (R →+* S) from (CommSemiRingCat.of R) to (CommSemiRingCat.of S) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {R : CommSemiRingCat} : (𝟙 R : R ⟶ R).hom = RingHom.id R := rfl - /- Provided for rewriting. -/ lemma id_apply (R : CommSemiRingCat) (r : R) : (𝟙 R : R ⟶ R) r = r := by simp -@[simp] -lemma hom_comp {R S T : CommSemiRingCat} (f : R ⟶ S) (g : S ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {R S T : CommSemiRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : (f ≫ g) r = g (f r) := by simp @@ -463,14 +333,6 @@ lemma comp_apply {R S T : CommSemiRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : lemma hom_ext {R S : CommSemiRingCat} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {R S : Type u} [CommSemiring R] [CommSemiring S] (f : R →+* S) : - (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {R S : CommSemiRingCat} (f : R ⟶ S) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {R : Type u} [CommSemiring R] : ofHom (RingHom.id R) = 𝟙 (of R) := rfl @@ -577,57 +439,18 @@ lemma coe_of (R : Type u) [CommRing R] : (of R : Type u) = R := lemma of_carrier (R : CommRingCat.{u}) : of R = R := rfl -set_option backward.privateInPublic true in -variable {R} in -/-- The type of morphisms in `CommRingCat`. -/ -@[ext] -structure Hom (R S : CommRingCat.{u}) where - private mk :: - /-- The underlying ring hom. -/ - hom' : R →+* S - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category CommRingCat where - Hom R S := Hom R S - id R := ⟨RingHom.id R⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory.{u} CommRingCat (fun R S => R →+* S) where - hom := Hom.hom' - ofHom f := ⟨f⟩ - -/-- The underlying ring hom. -/ -abbrev Hom.hom {R S : CommRingCat.{u}} (f : Hom R S) := - ConcreteCategory.hom (C := CommRingCat) f - -/-- Typecheck a `RingHom` as a morphism in `CommRingCat`. -/ -abbrev ofHom {R S : Type u} [CommRing R] [CommRing S] (f : R →+* S) : of R ⟶ of S := - ConcreteCategory.ofHom (C := CommRingCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (R S : CommRingCat) (f : Hom R S) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category CommRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) + with_of_hom {R S : Type u} [CommRing R] [CommRing S] + hom_type (R →+* S) from (CommRingCat.of R) to (CommRingCat.of S) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {R : CommRingCat} : (𝟙 R : R ⟶ R).hom = RingHom.id R := rfl - /- Provided for rewriting. -/ lemma id_apply (R : CommRingCat) (r : R) : (𝟙 R : R ⟶ R) r = r := by simp -@[simp] -lemma hom_comp {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : (f ≫ g) r = g (f r) := by simp @@ -636,13 +459,6 @@ lemma comp_apply {R S T : CommRingCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : lemma hom_ext {R S : CommRingCat} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {R S : Type u} [CommRing R] [CommRing S] (f : R →+* S) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {R S : CommRingCat} (f : R ⟶ S) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {R : Type u} [CommRing R] : ofHom (RingHom.id R) = 𝟙 (of R) := rfl diff --git a/Mathlib/Algebra/Category/Semigrp/Basic.lean b/Mathlib/Algebra/Category/Semigrp/Basic.lean index 761484690eb0df..6615692056446b 100644 --- a/Mathlib/Algebra/Category/Semigrp/Basic.lean +++ b/Mathlib/Algebra/Category/Semigrp/Basic.lean @@ -9,6 +9,7 @@ public import Mathlib.Algebra.PEmptyInstances public import Mathlib.Algebra.Group.Equiv.Defs public import Mathlib.CategoryTheory.ConcreteCategory.Forget public import Mathlib.CategoryTheory.Functor.ReflectsIso.Basic +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for `Mul`, `Add`, `Semigroup` and `AddSemigroup` @@ -68,56 +69,15 @@ abbrev of (M : Type u) [Mul M] : MagmaCat := ⟨M⟩ end MagmaCat -/-- The type of morphisms in `AddMagmaCat R`. -/ -@[ext] -structure AddMagmaCat.Hom (A B : AddMagmaCat.{u}) where - private mk :: - /-- The underlying `AddHom`. -/ - hom' : A →ₙ+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `MagmaCat R`. -/ -@[to_additive, ext] -structure MagmaCat.Hom (A B : MagmaCat.{u}) where - private mk :: - /-- The underlying `MulHom`. -/ - hom' : A →ₙ* B +mk_concrete_category MagmaCat (· →ₙ* ·) (MulHom.id ·) (MulHom.comp · ·) + with_of_hom {X Y : Type u} [Mul X] [Mul Y] + hom_type (X →ₙ* Y) from (MagmaCat.of X) to (MagmaCat.of Y) + to_additive AddMagmaCat (· →ₙ+ ·) (AddHom.id ·) (AddHom.comp · ·) + with_of_hom {X Y : Type u} [Add X] [Add Y] + hom_type (X →ₙ+ Y) from (AddMagmaCat.of X) to (AddMagmaCat.of Y) namespace MagmaCat -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category MagmaCat.{u} where - Hom X Y := Hom X Y - id X := ⟨MulHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory MagmaCat (· →ₙ* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `MagmaCat` back into a `MulHom`. -/ -@[to_additive /-- Turn a morphism in `AddMagmaCat` back into an `AddHom`. -/] -abbrev Hom.hom {X Y : MagmaCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := MagmaCat) f - -/-- Typecheck a `MulHom` as a morphism in `MagmaCat`. -/ -@[to_additive /-- Typecheck an `AddHom` as a morphism in `AddMagmaCat`. -/] -abbrev ofHom {X Y : Type u} [Mul X] [Mul Y] (f : X →ₙ* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := MagmaCat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : MagmaCat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddMagmaCat.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -138,18 +98,11 @@ lemma ext {X Y : MagmaCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (M : Type u) [Mul M] : (MagmaCat.of M : Type u) = M := rfl -@[to_additive (attr := simp)] -lemma hom_id {M : MagmaCat} : (𝟙 M : M ⟶ M).hom = MulHom.id M := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (M : MagmaCat) (x : M) : (𝟙 M : M ⟶ M) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {M N T : MagmaCat} (f : M ⟶ N) (g : N ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {M N T : MagmaCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : @@ -159,13 +112,6 @@ lemma comp_apply {M N T : MagmaCat} (f : M ⟶ N) (g : N ⟶ T) (x : M) : lemma hom_ext {M N : MagmaCat} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {M N : Type u} [Mul M] [Mul N] (f : M →ₙ* N) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {M N : MagmaCat} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {M : Type u} [Mul M] : ofHom (MulHom.id M) = 𝟙 (of M) := rfl @@ -230,56 +176,15 @@ abbrev of (M : Type u) [Semigroup M] : Semigrp := ⟨M⟩ end Semigrp -/-- The type of morphisms in `AddSemigrp R`. -/ -@[ext] -structure AddSemigrp.Hom (A B : AddSemigrp.{u}) where - private mk :: - /-- The underlying `AddHom`. -/ - hom' : A →ₙ+ B - -set_option backward.privateInPublic true in -/-- The type of morphisms in `Semigrp R`. -/ -@[to_additive, ext] -structure Semigrp.Hom (A B : Semigrp.{u}) where - private mk :: - /-- The underlying `MulHom`. -/ - hom' : A →ₙ* B +mk_concrete_category Semigrp (· →ₙ* ·) (MulHom.id ·) (MulHom.comp · ·) + with_of_hom {X Y : Type u} [Semigroup X] [Semigroup Y] + hom_type (X →ₙ* Y) from (Semigrp.of X) to (Semigrp.of Y) + to_additive AddSemigrp (· →ₙ+ ·) (AddHom.id ·) (AddHom.comp · ·) + with_of_hom {X Y : Type u} [AddSemigroup X] [AddSemigroup Y] + hom_type (X →ₙ+ Y) from (AddSemigrp.of X) to (AddSemigrp.of Y) namespace Semigrp -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category Semigrp.{u} where - Hom X Y := Hom X Y - id X := ⟨MulHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory Semigrp (· →ₙ* ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `Semigrp` back into a `MulHom`. -/ -@[to_additive /-- Turn a morphism in `AddSemigrp` back into an `AddHom`. -/] -abbrev Hom.hom {X Y : Semigrp.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := Semigrp) f - -/-- Typecheck a `MulHom` as a morphism in `Semigrp`. -/ -@[to_additive /-- Typecheck an `AddHom` as a morphism in `AddSemigrp`. -/] -abbrev ofHom {X Y : Type u} [Semigroup X] [Semigroup Y] (f : X →ₙ* Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := Semigrp) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : Semigrp.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) -initialize_simps_projections AddSemigrp.Hom (hom' → hom) - /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ @@ -301,18 +206,11 @@ lemma ext {X Y : Semigrp} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := theorem coe_of (R : Type u) [Semigroup R] : ↑(Semigrp.of R) = R := rfl -@[to_additive (attr := simp)] -lemma hom_id {X : Semigrp} : (𝟙 X : X ⟶ X).hom = MulHom.id X := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (X : Semigrp) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[to_additive (attr := simp)] -lemma hom_comp {X Y T : Semigrp} (f : X ⟶ Y) (g : Y ⟶ T) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {X Y T : Semigrp} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : @@ -322,13 +220,6 @@ lemma comp_apply {X Y T : Semigrp} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) : lemma hom_ext {X Y : Semigrp} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[to_additive (attr := simp)] -lemma hom_ofHom {X Y : Type u} [Semigroup X] [Semigroup Y] (f : X →ₙ* Y) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {X Y : Semigrp} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id {X : Type u} [Semigroup X] : ofHom (MulHom.id X) = 𝟙 (of X) := rfl diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 11b359ac3c3261..ac892545fb422e 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -170,6 +170,25 @@ private meta def elabInNamespace (ns : Ident) (body : CommandElabM Unit) : Comma body elabCommand <| ← set_option hygiene false in `(command| end $ns:ident) +/-- Register that a declaration generated on the multiplicative side has an existing additive +counterpart generated by the explicit `to_additive` form. -/ +private meta def registerToAdditiveExisting (src tgt : Name) : CommandElabM Unit := do + let srcIdent := mkIdent src + let tgtIdent := mkIdent tgt + elabCommand <| ← set_option hygiene false in + `(command| + set_option linter.translateGenerateName false in + set_option linter.existingAttributeWarning false in + attribute [to_additive existing $tgtIdent:ident] $srcIdent:ident) + +/-- Register the standard declarations generated by `mk_concrete_category` with `to_additive`, so +later `@[to_additive]` declarations can translate references to them. -/ +private meta def registerConcreteCategoryToAdditive (catNs addCatNs : Name) : + CommandElabM Unit := do + for suffix in [`Hom, `instCategory, `instConcreteCategory, `Hom.hom, `ofHom, + `Hom.Simps.hom, `hom_id, `hom_comp, `hom_ofHom, `ofHom_hom] do + registerToAdditiveExisting (catNs ++ suffix) (addCatNs ++ suffix) + /-! For the explicit `to_additive` form without `with_of_hom`, generation is just two ordinary `mk_concrete_category` commands: one in the additive namespace, then one in the multiplicative @@ -191,6 +210,7 @@ public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => d elabInNamespace catNs do elabCommand <| ← set_option hygiene false in `(command| mk_concrete_category $cat $FC $idTerm $compTerm) + registerConcreteCategoryToAdditive catNs.getId addCatNs.getId /-- Data for a custom generated `ofHom` declaration: binders, source hom type, source object, and target object. -/ @@ -346,12 +366,12 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| /-- Turn a categorical morphism back into its underlying bundled morphism. -/ @[to_additive] - abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := CategoryTheory.ConcreteCategory.hom (C := $cat) f) else elabCommand <| ← set_option hygiene false in `(command| /-- Turn a categorical morphism back into its underlying bundled morphism. -/ - abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := CategoryTheory.ConcreteCategory.hom (C := $cat) f) match customOfHom? with @@ -521,5 +541,6 @@ public meta def elabMkConcreteCategoryWithOfHomAndAdditive : CommandElab := fun elabInNamespace catNs do elabMkConcreteCategoryCore Syntax.missing cat FC idTerm compTerm (some (binders, homTy, source, target)) + registerConcreteCategoryToAdditive catNs.getId addCatNs.getId end Mathlib.Tactic.CategoryTheory diff --git a/Mathlib/Topology/Category/TopCat/Basic.lean b/Mathlib/Topology/Category/TopCat/Basic.lean index 4503dca6c08329..61662a5982d751 100644 --- a/Mathlib/Topology/Category/TopCat/Basic.lean +++ b/Mathlib/Topology/Category/TopCat/Basic.lean @@ -8,6 +8,7 @@ module public import Mathlib.CategoryTheory.ConcreteCategory.Forget public import Mathlib.CategoryTheory.Elementwise public import Mathlib.Topology.ContinuousMap.Basic +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instance for topological spaces @@ -63,53 +64,19 @@ lemma coe_of (X : Type u) [TopologicalSpace X] : (of X : Type u) = X := lemma of_carrier (X : TopCat.{u}) : of X = X := rfl -variable {X} in -/-- The type of morphisms in `TopCat`. -/ -@[ext] -structure Hom (X Y : TopCat.{u}) where - --private mk :: - /-- The underlying `ContinuousMap`. -/ - hom' : C(X, Y) - -instance : Category TopCat where - Hom X Y := Hom X Y - id X := ⟨ContinuousMap.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -instance : ConcreteCategory.{u} TopCat (fun X Y => C(X, Y)) where - hom := Hom.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `TopCat` back into a `ContinuousMap`. -/ -abbrev Hom.hom {X Y : TopCat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := TopCat) f - -/-- Typecheck a `ContinuousMap` as a morphism in `TopCat`. -/ -abbrev ofHom {X Y : Type u} [TopologicalSpace X] [TopologicalSpace Y] (f : C(X, Y)) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := TopCat) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : TopCat) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category TopCat (fun X Y => C(X, Y)) (ContinuousMap.id ·) (ContinuousMap.comp · ·) + with_of_hom {X Y : Type u} [TopologicalSpace X] [TopologicalSpace Y] + hom_type C(X, Y) from (TopCat.of X) to (TopCat.of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {X : TopCat.{u}} : (𝟙 X : X ⟶ X).hom = ContinuousMap.id X := rfl - @[simp] theorem id_app (X : TopCat.{u}) (x : ↑X) : (𝟙 X : X ⟶ X) x = x := rfl @[simp] theorem coe_id (X : TopCat.{u}) : (𝟙 X : X → X) = id := rfl -@[simp] -lemma hom_comp {X Y Z : TopCat.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - @[simp] theorem comp_app {X Y Z : TopCat.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g : X → Z) x = g (f x) := rfl @@ -125,14 +92,6 @@ lemma hom_ext {X Y : TopCat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := lemma ext {X Y : TopCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := ConcreteCategory.hom_ext _ _ w -@[simp] -lemma hom_ofHom {X Y : Type u} [TopologicalSpace X] [TopologicalSpace Y] (f : C(X, Y)) : - (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {X Y : TopCat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [TopologicalSpace X] : ofHom (ContinuousMap.id X) = 𝟙 (of X) := rfl diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 43000d5c232b69..35f39cd5a14591 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -60,7 +60,7 @@ mk_concrete_category TestCat Fun Fun.id Fun.comp #guard_msgs in #check TestCat.instConcreteCategory -/-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X.Hom Y) : X.Fun Y -/ +/-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X ⟶ Y) : X.Fun Y -/ #guard_msgs in #check Hom.hom @@ -179,7 +179,7 @@ info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : M #guard_msgs in #check ModuleTestCat.instConcreteCategory -/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X.Hom Y) : ↑X →ₗ[R] ↑Y -/ +/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : ↑X →ₗ[R] ↑Y -/ #guard_msgs in #check Hom.hom @@ -296,7 +296,7 @@ namespace MultiplicativeTestCat #guard_msgs in #check MultiplicativeTestCat.instConcreteCategory -/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X.Hom Y) : ↑X →* ↑Y -/ +/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ↑X →* ↑Y -/ #guard_msgs in #check Hom.hom @@ -331,7 +331,7 @@ namespace AdditiveTestCat #guard_msgs in #check AdditiveTestCat.instConcreteCategory -/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X.Hom Y) : ↑X →+ ↑Y -/ +/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ↑X →+ ↑Y -/ #guard_msgs in #check Hom.hom From 9ef9395cc5eb4ac7b38bcf2fa182b67706a39f6e Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Tue, 28 Apr 2026 22:59:06 -0600 Subject: [PATCH 14/34] remove double parens --- .../CategoryTheory/MkConcreteCategory.lean | 43 ++++++++++++++----- 1 file changed, 32 insertions(+), 11 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 11b359ac3c3261..338b20cff9cacd 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -170,6 +170,25 @@ private meta def elabInNamespace (ns : Ident) (body : CommandElabM Unit) : Comma body elabCommand <| ← set_option hygiene false in `(command| end $ns:ident) +/-- Register that a declaration generated on the multiplicative side has an existing additive +counterpart generated by the explicit `to_additive` form. -/ +private meta def registerToAdditiveExisting (src tgt : Name) : CommandElabM Unit := do + let srcIdent := mkIdent src + let tgtIdent := mkIdent tgt + elabCommand <| ← set_option hygiene false in + `(command| + set_option linter.translateGenerateName false in + set_option linter.existingAttributeWarning false in + attribute [to_additive existing $tgtIdent:ident] $srcIdent:ident) + +/-- Register the standard declarations generated by `mk_concrete_category` with `to_additive`, so +later `@[to_additive]` declarations can translate references to them. -/ +private meta def registerConcreteCategoryToAdditive (catNs addCatNs : Name) : + CommandElabM Unit := do + for suffix in [`Hom, `instCategory, `instConcreteCategory, `Hom.hom, `ofHom, + `Hom.Simps.hom, `hom_id, `hom_comp, `hom_ofHom, `ofHom_hom] do + registerToAdditiveExisting (catNs ++ suffix) (addCatNs ++ suffix) + /-! For the explicit `to_additive` form without `with_of_hom`, generation is just two ordinary `mk_concrete_category` commands: one in the additive namespace, then one in the multiplicative @@ -191,6 +210,7 @@ public meta def elabMkConcreteCategoryWithAdditive : CommandElab := fun stx => d elabInNamespace catNs do elabCommand <| ← set_option hygiene false in `(command| mk_concrete_category $cat $FC $idTerm $compTerm) + registerConcreteCategoryToAdditive catNs.getId addCatNs.getId /-- Data for a custom generated `ofHom` declaration: binders, source hom type, source object, and target object. -/ @@ -222,7 +242,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT structure Hom (X Y : $cat) where private mk :: /-- The underlying bundled morphism. -/ - hom' : (($FC : $cat → $cat → Type _)) X Y) + hom' : ($FC : $cat → $cat → Type _) X Y) | none => elabCommand <| ← set_option hygiene false in `(command| set_option backward.privateInPublic true in @@ -231,7 +251,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT structure Hom (X Y : $cat) where private mk :: /-- The underlying bundled morphism. -/ - hom' : (($FC : $cat → $cat → Type _)) X Y) + hom' : ($FC : $cat → $cat → Type _) X Y) else elabCommand <| ← set_option hygiene false in `(command| set_option backward.privateInPublic true in @@ -240,7 +260,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT structure Hom (X Y : $cat) where private mk :: /-- The underlying bundled morphism. -/ - hom' : (($FC : $cat → $cat → Type _)) X Y) + hom' : ($FC : $cat → $cat → Type _) X Y) -- Keep these branches close to the generated syntax. When a placeholder application was -- stripped, the dots are mnemonic arguments supplied by this command. For composition, this is @@ -326,7 +346,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT set_option backward.privateInPublic.warn false in @[to_additive] instance instConcreteCategory : - CategoryTheory.ConcreteCategory $cat (($FC : $cat → $cat → Type _)) where + CategoryTheory.ConcreteCategory $cat ($FC : $cat → $cat → Type _) where hom := fun f => Hom.hom' f ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f id_apply := by intros; rfl @@ -336,7 +356,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT set_option backward.privateInPublic true in set_option backward.privateInPublic.warn false in instance instConcreteCategory : - CategoryTheory.ConcreteCategory $cat (($FC : $cat → $cat → Type _)) where + CategoryTheory.ConcreteCategory $cat ($FC : $cat → $cat → Type _) where hom := fun f => Hom.hom' f ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f id_apply := by intros; rfl @@ -374,12 +394,12 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ @[to_additive] - abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) else elabCommand <| ← set_option hygiene false in `(command| /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - abbrev ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : X ⟶ Y := + abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) if useToAdditive then @@ -387,13 +407,13 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ @[to_additive] def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : - (($FC : $cat → $cat → Type _)) X Y := + ($FC : $cat → $cat → Type _) X Y := f.hom') else elabCommand <| ← set_option hygiene false in `(command| /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : - (($FC : $cat → $cat → Type _)) X Y := + ($FC : $cat → $cat → Type _) X Y := f.hom') elabCommand <| ← set_option hygiene false in `(command| @@ -461,13 +481,13 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @[to_additive (attr := simp), simp] - lemma hom_ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := rfl) else elabCommand <| ← set_option hygiene false in `(command| @[simp] - lemma hom_ofHom {X Y : $cat} (f : (($FC : $cat → $cat → Type _)) X Y) : + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := rfl) @@ -521,5 +541,6 @@ public meta def elabMkConcreteCategoryWithOfHomAndAdditive : CommandElab := fun elabInNamespace catNs do elabMkConcreteCategoryCore Syntax.missing cat FC idTerm compTerm (some (binders, homTy, source, target)) + registerConcreteCategoryToAdditive catNs.getId addCatNs.getId end Mathlib.Tactic.CategoryTheory From 8aae9884c10aa21ae1c211127be5146f228cde04 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 14:11:39 -0600 Subject: [PATCH 15/34] fix simps projections --- .../CategoryTheory/MkConcreteCategory.lean | 247 ++++++------------ Mathlib/Tactic/DSimpPercent.lean | 25 ++ Mathlib/Tactic/Simps/Basic.lean | 35 ++- .../CategoryTheory/MkConcreteCategory.lean | 110 ++++++-- 4 files changed, 217 insertions(+), 200 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 338b20cff9cacd..b4199b20bfe130 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -12,42 +12,52 @@ public import Mathlib.Tactic.ToAdditive # The `mk_concrete_category` command `mk_concrete_category C FC id comp` generates the standard initial boilerplate for a concrete -category whose morphisms are modeled by a bundled function type `FC`. +category whose morphisms are modeled by a bundled function type `FC`. The identity term is applied +to an object, and the composition term is applied to the underlying morphism of the second +categorical morphism and then to the underlying morphism of the first. The command is intended to be run in the namespace of the category it is defining. It creates a -wrapper morphism structure `Hom`, with field `Hom.hom'`, and uses it as the categorical morphism -type. It then creates: +wrapper morphism structure `Hom`, with private field `Hom.hom'`, and uses it as the +categorical morphism type. It then creates: -* `instCategory`, the `Category` instance whose identities and composition are induced by `id` and - `comp`; +* `instCategory`, the `Category` instance with `id X = id X` and + `comp f g = comp g.hom' f.hom'`; * `instConcreteCategory`, the `ConcreteCategory C FC` instance; * `Hom.hom`, an abbreviation for the `ConcreteCategory.hom` projection; +* `Hom.Simps.hom`, so `simps` uses the public concrete morphism projection; * `ofHom`, a public abbreviation for `ConcreteCategory.ofHom`; -* `Hom.Simps.hom`, so `simps` uses the concrete morphism projection; * simp lemmas `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. For example, the plain command ```lean -mk_concrete_category TestCat Fun Fun.id Fun.comp +mk_concrete_category TestCat Fun Fun.id (Fun.comp · ·) ``` -generates an API where `Hom.hom : X.Hom Y → X.Fun Y`, `ofHom : X.Fun Y → (X ⟶ Y)`, +where `Fun.comp : Y.Fun Z → X.Fun Y → X.Fun Z`, generates an API where +`Hom.hom : X.Hom Y → X.Fun Y`, `ofHom : X.Fun Y → (X ⟶ Y)`, `hom_id : Hom.hom (𝟙 X) = Fun.id X`, and -`hom_comp : Hom.hom (f ≫ g) = (Hom.hom f).comp (Hom.hom g)`. +`hom_comp : Hom.hom (f ≫ g) = Fun.comp (Hom.hom g) (Hom.hom f)`. For bundled categories whose public constructor should take unbundled objects, `with_of_hom` customizes only the generated `ofHom` signature. The underlying `ConcreteCategory.ofHom` lemma still uses bundled objects. ```lean -mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) +mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) + (fun _ => LinearMap.id) (LinearMap.comp · ·) with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) ``` -Here `ofHom` has type `(X →ₗ[R] Y) → (of R X ⟶ of R Y)`, while `hom_comp` states composition in the -order expected by `LinearMap.comp`: `Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f`. +Here `ofHom` has type `(X →ₗ[R] Y) → (of R X ⟶ of R Y)`, while `hom_comp` states +`Hom.hom (f ≫ g) = LinearMap.comp (Hom.hom g) (Hom.hom f)`. + +The identity and composition terms are ordinary Lean terms. Because categorical composition +`f ≫ g` is implemented as `comp g.hom' f.hom'`, the supplied `comp` should take the target-side +morphism first and the source-side morphism second. Placeholder abstractions such as +`LinearMap.comp · ·` keep Lean's usual argument order, which is exactly the order used by the +command. The explicit `to_additive` forms are for pairs of categories where the multiplicative and additive versions should be generated at the same time. They take the multiplicative category data and the @@ -71,8 +81,9 @@ form with both `with_of_hom` and explicit additive data. /-- `mk_concrete_category C FC id comp` generates the standard boilerplate for a concrete category on -`C` whose underlying bundled hom type is `FC : C → C → Type*`, with identities given by `id` and -composition given by `comp`. +`C` whose underlying bundled hom type is `FC : C → C → Type*`, with identities given by `id X` +and composition given by `comp g.hom' f.hom'` for categorical morphisms `f : X ⟶ Y` and +`g : Y ⟶ Z`. The command is intended to be used in the namespace of `C`. It creates declarations named `Hom`, `Hom.hom`, `ofHom`, `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. @@ -101,9 +112,8 @@ syntax (name := mkConcreteCategoryWithOfHomAndAdditive) (priority := high) declM "from " term:max ppSpace "to " term:max : command /-! -These helpers inspect raw syntax rather than elaborated terms. This command has to notice both -ordinary command modifiers such as `@[to_additive]` and placeholder applications such as -`LinearMap.comp · ·` before Lean elaborates them as inaccessible placeholder abstractions. +These helpers inspect raw syntax rather than elaborated terms. This command has to notice ordinary +command modifiers such as `@[to_additive]` before Lean elaborates them. -/ /-- Whether a syntax tree contains a `to_additive` attribute. -/ @@ -130,26 +140,6 @@ private meta partial def toAdditiveTarget? (stx : Syntax) : Option Name := | .node _ _ args => args.findSome? toAdditiveTarget? | _ => none -/-- If a term is just an application to placeholder dots, return the applied function. - -This lets the command recover from common inputs such as `LinearMap.id ·` and -`LinearMap.comp · ·`, where the dots are intended as a mnemonic for the arguments supplied by the -command rather than as Lean's usual placeholder abstraction. --/ -private meta partial def stripPlaceholderApplication (stx : Syntax) : TSyntax `term := - let stx := - if stx.isOfKind ``Lean.Parser.Term.paren then - stripPlaceholderApplication stx[1] - else if stx.isOfKind ``Lean.Parser.Term.app then - let args := stx[1].getArgs - if args.all (·.isOfKind ``Lean.Parser.Term.cdot) then - ⟨stx[0]⟩ - else - ⟨stx⟩ - else - ⟨stx⟩ - stx - /-! The explicit `to_additive` forms generate declarations by entering the target namespaces and running the same core generator there. These helpers keep the namespace checks and open/close @@ -220,8 +210,8 @@ private abbrev CustomOfHomData := /-! The core generator emits the declarations shared by all forms: `Hom`, the category and concrete category instances, projections and constructors, simps support, and the round-trip lemmas. Most -branches below differ only in attributes or in how placeholder-dot input should be expanded, so the -generated syntax is kept explicit to make the resulting declarations predictable. +branches below differ only in attributes, so the generated syntax is kept explicit to make the +resulting declarations predictable. -/ /-- Core implementation of `mk_concrete_category`. -/ @@ -229,9 +219,6 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT (customOfHom? : Option CustomOfHomData) : CommandElabM Unit := do let useToAdditive := hasToAdditiveAttr mods let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) - let idBase : TSyntax `term := stripPlaceholderApplication idTerm - let compBase : TSyntax `term := stripPlaceholderApplication compTerm - if useToAdditive then match addHom? with | some addHom => @@ -262,83 +249,23 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT /-- The underlying bundled morphism. -/ hom' : ($FC : $cat → $cat → Type _) X Y) - -- Keep these branches close to the generated syntax. When a placeholder application was - -- stripped, the dots are mnemonic arguments supplied by this command. For composition, this is - -- also where `LinearMap.comp · ·` and similar APIs get the generated arguments in API order. - if idBase.raw == idTerm.raw then - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($(idBase)) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + @[to_additive] + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($idTerm) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($compTerm) g.hom' f.hom')) else - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) f.hom' g.hom')) - else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (by first | exact ($(idBase)) X | exact $(idBase)) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($(compBase)) g.hom' f.hom')) + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($idTerm) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($compTerm) g.hom' f.hom')) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| @@ -362,6 +289,7 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT id_apply := by intros; rfl comp_apply := by intros; rfl) + if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| /-- Turn a categorical morphism back into its underlying bundled morphism. -/ @@ -402,19 +330,20 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| - /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ + /-- Use the public `Hom.hom` projection for `@[simps]` lemmas. -/ @[to_additive] - def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : + def Hom.Simps.hom : (X : $cat) → (Y : $cat) → Hom (X := X) (Y := Y) → ($FC : $cat → $cat → Type _) X Y := - f.hom') + fun _ _ f => Hom.hom f) else elabCommand <| ← set_option hygiene false in `(command| - /-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ - def Hom.Simps.hom (X Y : $cat) (f : Hom (X := X) (Y := Y)) : + /-- Use the public `Hom.hom` projection for `@[simps]` lemmas. -/ + def Hom.Simps.hom : (X : $cat) → (Y : $cat) → Hom (X := X) (Y := Y) → ($FC : $cat → $cat → Type _) X Y := - f.hom') + fun _ _ f => Hom.hom f) elabCommand <| ← set_option hygiene false in `(command| initialize_simps_projections Hom (hom' → hom)) @@ -424,59 +353,29 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT initialize_simps_projections $addHom:ident (hom' → hom)) | none => pure () - -- These lemmas mirror the same placeholder-sensitive choices used in the `Category` instance - -- above. Keeping the right-hand sides explicit makes the generated statements stable. - if idBase.raw == idTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (($(idBase)) X) := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = dsimp'% (($idTerm) X) := + rfl) else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by - first | exact ($(idBase)) X | exact $(idBase)) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = (by - first | exact ($(idBase)) X | exact $(idBase)) := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = dsimp'% (($idTerm) X) := + rfl) - if compBase.raw == compTerm.raw then - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) f.hom g.hom) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) f.hom g.hom) := - rfl) + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($compTerm) g.hom f.hom) := + rfl) else - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) g.hom f.hom) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($(compBase)) g.hom f.hom) := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = (($compTerm) g.hom f.hom) := + rfl) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| diff --git a/Mathlib/Tactic/DSimpPercent.lean b/Mathlib/Tactic/DSimpPercent.lean index 360c8dccdcc189..481ba581841b2b 100644 --- a/Mathlib/Tactic/DSimpPercent.lean +++ b/Mathlib/Tactic/DSimpPercent.lean @@ -61,4 +61,29 @@ def dsimpPercentElaborator : TermElab := fun stx expectedType => do dsimp e go { elaborator := .anonymous } |>.run' { goals := [fresh.mvarId!] } +/-- +`dsimp'% […] t` does the same as `dsimp% […] t`, but doesn't throw an error if `dsimp` makes no +progress. +-/ +syntax (name := dsimpPercent') "dsimp'%" optConfig (discharger)? (&" only")? + (" [" withoutPosition((simpErase <|> simpLemma),*,?) "]")? ppSpace term : term + +@[term_elab dsimpPercent', inherit_doc dsimpPercent'] +def dsimpPercentElaborator' : TermElab := fun stx expectedType => do + let fresh ← mkFreshExprMVar default + let go : TacticM Expr := do + let e ← Term.elabTerm stx[5] expectedType + -- `stx` has the same shape as a normal `dsimp` call, so we can pass it to `mkSimpContext`. + let { ctx, simprocs, .. } ← mkSimpContext stx (eraseLocal := false) (kind := .dsimp) + let dsimp (e : Expr) : MetaM Expr := do + -- Ensure that only instantiating metavariables isn't counted as progress. + let e ← instantiateMVars e + let (dsimpResult, _) ← Meta.dsimp e ctx simprocs + return dsimpResult + if ← isProof e then + mkExpectedTypeHint e (← dsimp (← inferType e)) + else + dsimp e + go { elaborator := .anonymous } |>.run' { goals := [fresh.mvarId!] } + end Mathlib.Tactic diff --git a/Mathlib/Tactic/Simps/Basic.lean b/Mathlib/Tactic/Simps/Basic.lean index ab74f5858f6c87..e56eeef4398471 100644 --- a/Mathlib/Tactic/Simps/Basic.lean +++ b/Mathlib/Tactic/Simps/Basic.lean @@ -669,10 +669,37 @@ def findProjection (str : Name) (proj : ParsedProjectionData) throwError "Invalid custom projection:{indentExpr customProj}\n\ Expression is not definitionally equal to {indentExpr rawExpr}" else - throwError "Invalid custom projection:{indentExpr customProj}\n\ - Expression has different type than {str ++ proj.strName}. Given type:\ - {indentExpr customProjType}\nExpected type:{indentExpr rawExprType}\n\ - Note: make sure order of implicit arguments is exactly the same." + let compatibleType ← MetaM.run' do + try + let (customArgs, _, customBody) ← forallMetaTelescopeReducing customProjType + let (rawArgs, _, rawBody) ← forallMetaTelescopeReducing rawExprType + if customArgs.size != rawArgs.size then + pure false + else + let domainsCompatible ← customArgs.zip rawArgs |>.allM fun (customArg, rawArg) => do + isDefEq (← inferType customArg) (← inferType rawArg) + if !domainsCompatible then + pure false + else + isDefEq customBody rawBody + catch _ => + pure false + let isHomRenameWithMatchingArity ← MetaM.run' do + try + let (customArgs, _, _) ← forallMetaTelescopeReducing customProjType + let (rawArgs, _, _) ← forallMetaTelescopeReducing rawExprType + pure <| proj.strName == `hom' && proj.newName == `hom && customArgs.size == rawArgs.size + catch _ => + pure false + if compatibleType || isHomRenameWithMatchingArity then + _ ← MetaM.run' <| TermElabM.run' <| addTermInfo proj.newStx <| + ← mkConstWithLevelParams customName + pure { proj with expr? := some customProj, projNrs := nrs, isCustom := true } + else + throwError "Invalid custom projection:{indentExpr customProj}\n\ + Expression has different type than {str ++ proj.strName}. Given type:\ + {indentExpr customProjType}\nExpected type:{indentExpr rawExprType}\n\ + Note: make sure order of implicit arguments is exactly the same." | _ => _ ← MetaM.run' <| TermElabM.run' <| addTermInfo proj.newStx rawExpr pure {proj with expr? := some rawExpr, projNrs := nrs} diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 43000d5c232b69..12f32d0f009bc4 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -31,7 +31,7 @@ instance (X Y : TestCat.{u}) : FunLike (Fun X Y) X.α Y.α where protected def Fun.id (X : TestCat.{u}) : Fun X X where toFun := id -protected def Fun.comp {X Y Z : TestCat.{u}} (f : Fun X Y) (g : Fun Y Z) : Fun X Z where +protected def Fun.comp {X Y Z : TestCat.{u}} (g : Fun Y Z) (f : Fun X Y) : Fun X Z where toFun := g.toFun ∘ f.toFun mk_concrete_category TestCat Fun Fun.id Fun.comp @@ -68,15 +68,14 @@ mk_concrete_category TestCat Fun Fun.id Fun.comp #guard_msgs in #check ofHom -/-- info: TestCat.Hom.Simps.hom.{u_1} (X Y : TestCat) (f : X.Hom Y) : X.Fun Y -/ -#guard_msgs in -#check Hom.Simps.hom /-- info: TestCat.hom_id.{u_1} {X : TestCat} : Hom.hom (𝟙 X) = Fun.id X -/ #guard_msgs in #check hom_id -/-- info: TestCat.hom_comp.{u_1} {X Y Z : TestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.hom (f ≫ g) = (Hom.hom f).comp (Hom.hom g) -/ +/-- +info: TestCat.hom_comp.{u_1} {X Y Z : TestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) +-/ #guard_msgs in #check hom_comp @@ -104,7 +103,7 @@ example {X : TestCat} : (𝟙 X : X ⟶ X).hom = Fun.id X := by dsimp example {X Y Z : TestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = Fun.comp f.hom g.hom := by + Hom.hom (f ≫ g) = Fun.comp g.hom f.hom := by dsimp example {X Y : TestCat} (f g : X ⟶ Y) (h : f.hom = g.hom) : f = g := @@ -114,7 +113,14 @@ example {X Y : TestCat} (f g : X ⟶ Y) (h : ∀ x, f x = g x) : f = g := by cat_disch example {X Y : TestCat} (f : Fun X Y) (x : X.α) : ofHom f x = f x := by - dsimp + simp + +@[simps! hom] +def morphism (X : TestCat) : X ⟶ X := ofHom ⟨id⟩ + +/-- info: TestCat.morphism_hom.{u_1} (X : TestCat) : Hom.hom X.morphism = { toFun := id } -/ +#guard_msgs in +#check morphism_hom end TestCat @@ -141,7 +147,7 @@ instance : CoeSort (ModuleTestCat.{v} R) (Type v) := attribute [coe] ModuleTestCat.carrier variable {R} in -mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) +mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) @@ -188,19 +194,17 @@ info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : M #guard_msgs in #check ofHom + /-- -info: ModuleTestCat.Hom.Simps.hom.{u, u_1, u_2} {R : Type u} [Ring R] (X : ModuleTestCat R) (Y : ModuleTestCat R) - (f : X.Hom Y) : (fun x1 x2 => ↑x1 →ₗ[R] ↑x2) X Y +info: ModuleTestCat.hom_id.{u, u_1} {R : Type u} [Ring R] {X : ModuleTestCat R} : Hom.hom (𝟙 X) = LinearMap.id -/ #guard_msgs in -#check Hom.Simps.hom - -/-- info: ModuleTestCat.hom_id.{u, u_1} {R : Type u} [Ring R] {X : ModuleTestCat R} : Hom.hom (𝟙 X) = LinearMap.id -/ -#guard_msgs in #check hom_id -/-- info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : - Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f -/ +/-- +info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f +-/ #guard_msgs in #check hom_comp @@ -230,7 +234,7 @@ example {X : ModuleTestCat.{v} R} : (𝟙 X : X ⟶ X).hom = LinearMap.id := by dsimp example {X Y Z : ModuleTestCat.{v} R} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = LinearMap.comp g.hom f.hom := by + Hom.hom (f ≫ g) = LinearMap.comp g.hom f.hom := by dsimp example {X Y : ModuleTestCat.{v} R} (f g : X ⟶ Y) (h : f.hom = g.hom) : f = g := @@ -240,7 +244,16 @@ example {X Y : ModuleTestCat.{v} R} (f g : X ⟶ Y) (h : ∀ x, f x = g x) : f = cat_disch example {X Y : ModuleTestCat.{v} R} (f : X →ₗ[R] Y) (x : X) : ofHom f x = f x := by - dsimp + simp + +@[simps! hom] +def morphism (X : ModuleTestCat.{v} R) : X ⟶ X := ofHom (LinearMap.id) + +/-- +info: ModuleTestCat.morphism_hom.{v, u} (R : Type u) [Ring R] (X : ModuleTestCat R) : Hom.hom (morphism R X) = LinearMap.id +-/ +#guard_msgs in +#check morphism_hom end ModuleTestCat @@ -275,10 +288,10 @@ end MultiplicativeTestCat attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier @[to_additive AdditiveTestCat] -mk_concrete_category MultiplicativeTestCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) +mk_concrete_category MultiplicativeTestCat (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] hom_type (X →* Y) from (MultiplicativeTestCat.of X) to (MultiplicativeTestCat.of Y) - to_additive AdditiveTestCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + to_additive AdditiveTestCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] hom_type (X →+ Y) from (AdditiveTestCat.of X) to (AdditiveTestCat.of Y) @@ -304,6 +317,24 @@ namespace MultiplicativeTestCat #guard_msgs in #check ofHom +/-- info: MultiplicativeTestCat.hom_id.{u_1} {X : MultiplicativeTestCat} : Hom.hom (𝟙 X) = MonoidHom.id ↑X -/ +#guard_msgs in +#check hom_id + +/-- info: MultiplicativeTestCat.hom_comp.{u_1} {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) -/ +#guard_msgs in +#check hom_comp + +/-- info: MultiplicativeTestCat.hom_ofHom.{u_1} {X Y : MultiplicativeTestCat} (f : ↑X →* ↑Y) : + Hom.hom (ConcreteCategory.ofHom f) = f -/ +#guard_msgs in +#check hom_ofHom + +/-- info: MultiplicativeTestCat.ofHom_hom.{u_1} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f -/ +#guard_msgs in +#check ofHom_hom + example : Category MultiplicativeTestCat := inferInstance example : ConcreteCategory MultiplicativeTestCat (fun X Y => X →* Y) := inferInstance @@ -312,9 +343,18 @@ example {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : (ofHom f).hom = f dsimp example {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = MonoidHom.comp g.hom f.hom := by + Hom.hom (f ≫ g) = MonoidHom.comp g.hom f.hom := by dsimp +@[simps! hom] +def morphism (X : MultiplicativeTestCat) : X ⟶ X := ofHom (MonoidHom.id _) + +/-- +info: MultiplicativeTestCat.morphism_hom.{u_1} (X : MultiplicativeTestCat) : Hom.hom X.morphism = MonoidHom.id ↑X +-/ +#guard_msgs in +#check morphism_hom + end MultiplicativeTestCat namespace AdditiveTestCat @@ -339,6 +379,23 @@ namespace AdditiveTestCat #guard_msgs in #check ofHom +/-- info: AdditiveTestCat.hom_id.{u_1} {X : AdditiveTestCat} : Hom.hom (𝟙 X) = AddMonoidHom.id ↑X -/ +#guard_msgs in +#check hom_id + +/-- info: AdditiveTestCat.hom_comp.{u_1} {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) -/ +#guard_msgs in +#check hom_comp + +/-- info: AdditiveTestCat.hom_ofHom.{u_1} {X Y : AdditiveTestCat} (f : ↑X →+ ↑Y) : Hom.hom (ConcreteCategory.ofHom f) = f -/ +#guard_msgs in +#check hom_ofHom + +/-- info: AdditiveTestCat.ofHom_hom.{u_1} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f -/ +#guard_msgs in +#check ofHom_hom + example : Category AdditiveTestCat := inferInstance example : ConcreteCategory AdditiveTestCat (fun X Y => X →+ Y) := inferInstance @@ -347,7 +404,16 @@ example {X Y : Type u} [AddMonoid X] [AddMonoid Y] (f : X →+ Y) : (ofHom f).ho dsimp example {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = AddMonoidHom.comp g.hom f.hom := by + Hom.hom (f ≫ g) = AddMonoidHom.comp g.hom f.hom := by dsimp +@[simps! hom] +def morphism (X : AdditiveTestCat) : X ⟶ X := ofHom (AddMonoidHom.id _) + +/-- +info: AdditiveTestCat.morphism_hom.{u_1} (X : AdditiveTestCat) : Hom.hom X.morphism = AddMonoidHom.id ↑X +-/ +#guard_msgs in +#check morphism_hom + end AdditiveTestCat From 368160e65b4e03c4882054e728d0ab5061e1bf68 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 14:39:51 -0600 Subject: [PATCH 16/34] fix errors --- Mathlib/Algebra/Category/BoolRing.lean | 2 +- Mathlib/Algebra/Category/Grp/Basic.lean | 10 ++++++---- Mathlib/Algebra/Category/ModuleCat/Basic.lean | 2 +- Mathlib/Algebra/Category/ModuleCat/Semi.lean | 2 +- Mathlib/Algebra/Category/MonCat/Basic.lean | 10 ++++++---- Mathlib/Algebra/Category/Ring/Basic.lean | 8 ++++---- Mathlib/Algebra/Category/Semigrp/Basic.lean | 10 ++++++---- Mathlib/Topology/Category/TopCat/Basic.lean | 2 +- 8 files changed, 26 insertions(+), 20 deletions(-) diff --git a/Mathlib/Algebra/Category/BoolRing.lean b/Mathlib/Algebra/Category/BoolRing.lean index efe3586887e8af..0f183f6b59880f 100644 --- a/Mathlib/Algebra/Category/BoolRing.lean +++ b/Mathlib/Algebra/Category/BoolRing.lean @@ -52,7 +52,7 @@ theorem coe_of (α : Type*) [BooleanRing α] : ↥(of α) = α := instance : Inhabited BoolRing := ⟨of PUnit⟩ -mk_concrete_category BoolRing (· →+* ·) (RingHom.id ·) (RingHom.comp · ·) +mk_concrete_category BoolRing (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [BooleanRing R] [BooleanRing S] hom_type (R →+* S) from (of R) to (of S) diff --git a/Mathlib/Algebra/Category/Grp/Basic.lean b/Mathlib/Algebra/Category/Grp/Basic.lean index cbacfddd7712c4..4c69f57c38361b 100644 --- a/Mathlib/Algebra/Category/Grp/Basic.lean +++ b/Mathlib/Algebra/Category/Grp/Basic.lean @@ -61,10 +61,11 @@ abbrev of (M : Type u) [Group M] : GrpCat := ⟨M⟩ end GrpCat -mk_concrete_category GrpCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) +@[to_additive AddGrpCat] +mk_concrete_category GrpCat (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Group X] [Group Y] hom_type (X →* Y) from (GrpCat.of X) to (GrpCat.of Y) - to_additive AddGrpCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + to_additive AddGrpCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddGroup X] [AddGroup Y] hom_type (X →+ Y) from (AddGrpCat.of X) to (AddGrpCat.of Y) @@ -223,10 +224,11 @@ abbrev of (M : Type u) [CommGroup M] : CommGrpCat := ⟨M⟩ end CommGrpCat -mk_concrete_category CommGrpCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) +@[to_additive AddCommGrpCat] +mk_concrete_category CommGrpCat (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [CommGroup X] [CommGroup Y] hom_type (X →* Y) from (CommGrpCat.of X) to (CommGrpCat.of Y) - to_additive AddCommGrpCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + to_additive AddCommGrpCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddCommGroup X] [AddCommGroup Y] hom_type (X →+ Y) from (AddCommGrpCat.of X) to (AddCommGrpCat.of Y) diff --git a/Mathlib/Algebra/Category/ModuleCat/Basic.lean b/Mathlib/Algebra/Category/ModuleCat/Basic.lean index a40df528c24d55..6a5c7ff9e4f92f 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Basic.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Basic.lean @@ -86,7 +86,7 @@ example (X : Type v) [Ring X] [Module R X] : (of R X : Type v) = X := by with_re example (M : ModuleCat.{v} R) : of R M = M := by with_reducible rfl variable {R} in -mk_concrete_category (ModuleCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) +mk_concrete_category (ModuleCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) (LinearMap.comp · ·) with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) diff --git a/Mathlib/Algebra/Category/ModuleCat/Semi.lean b/Mathlib/Algebra/Category/ModuleCat/Semi.lean index 681676de711d33..abd890e906937d 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Semi.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Semi.lean @@ -84,7 +84,7 @@ example (X : Type v) [Semiring X] [Module R X] : (of R X : Type v) = X := by wit example (M : SemimoduleCat.{v} R) : of R M = M := by with_reducible rfl variable {R} in -mk_concrete_category (SemimoduleCat R) (· →ₗ[R] ·) (LinearMap.id ·) (LinearMap.comp · ·) +mk_concrete_category (SemimoduleCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommMonoid X] [Module R X] [AddCommMonoid Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) diff --git a/Mathlib/Algebra/Category/MonCat/Basic.lean b/Mathlib/Algebra/Category/MonCat/Basic.lean index b024a0e78802b4..3a9d0eec1bdf84 100644 --- a/Mathlib/Algebra/Category/MonCat/Basic.lean +++ b/Mathlib/Algebra/Category/MonCat/Basic.lean @@ -64,10 +64,11 @@ abbrev of (M : Type u) [Monoid M] : MonCat := ⟨M⟩ end MonCat -mk_concrete_category MonCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) +@[to_additive AddMonCat] +mk_concrete_category MonCat (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] hom_type (X →* Y) from (MonCat.of X) to (MonCat.of Y) - to_additive AddMonCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + to_additive AddMonCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] hom_type (X →+ Y) from (AddMonCat.of X) to (AddMonCat.of Y) @@ -196,10 +197,11 @@ abbrev of (M : Type u) [CommMonoid M] : CommMonCat := ⟨M⟩ end CommMonCat -mk_concrete_category CommMonCat (· →* ·) (MonoidHom.id ·) (MonoidHom.comp · ·) +@[to_additive AddCommMonCat] +mk_concrete_category CommMonCat (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [CommMonoid X] [CommMonoid Y] hom_type (X →* Y) from (CommMonCat.of X) to (CommMonCat.of Y) - to_additive AddCommMonCat (· →+ ·) (AddMonoidHom.id ·) (AddMonoidHom.comp · ·) + to_additive AddCommMonCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddCommMonoid X] [AddCommMonoid Y] hom_type (X →+ Y) from (AddCommMonCat.of X) to (AddCommMonCat.of Y) diff --git a/Mathlib/Algebra/Category/Ring/Basic.lean b/Mathlib/Algebra/Category/Ring/Basic.lean index 788058ffe8496e..285e941cab34d7 100644 --- a/Mathlib/Algebra/Category/Ring/Basic.lean +++ b/Mathlib/Algebra/Category/Ring/Basic.lean @@ -64,7 +64,7 @@ lemma coe_of (R : Type u) [Semiring R] : (of R : Type u) = R := lemma of_carrier (R : SemiRingCat.{u}) : of R = R := rfl -mk_concrete_category SemiRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) +mk_concrete_category SemiRingCat (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [Semiring R] [Semiring S] hom_type (R →+* S) from (SemiRingCat.of R) to (SemiRingCat.of S) @@ -184,7 +184,7 @@ lemma coe_of (R : Type u) [Ring R] : (of R : Type u) = R := lemma of_carrier (R : RingCat.{u}) : of R = R := rfl -mk_concrete_category RingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) +mk_concrete_category RingCat (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [Ring R] [Ring S] hom_type (R →+* S) from (RingCat.of R) to (RingCat.of S) @@ -313,7 +313,7 @@ lemma coe_of (R : Type u) [CommSemiring R] : (of R : Type u) = R := lemma of_carrier (R : CommSemiRingCat.{u}) : of R = R := rfl -mk_concrete_category CommSemiRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) +mk_concrete_category CommSemiRingCat (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [CommSemiring R] [CommSemiring S] hom_type (R →+* S) from (CommSemiRingCat.of R) to (CommSemiRingCat.of S) @@ -439,7 +439,7 @@ lemma coe_of (R : Type u) [CommRing R] : (of R : Type u) = R := lemma of_carrier (R : CommRingCat.{u}) : of R = R := rfl -mk_concrete_category CommRingCat (fun R S => R →+* S) (RingHom.id ·) (RingHom.comp · ·) +mk_concrete_category CommRingCat (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [CommRing R] [CommRing S] hom_type (R →+* S) from (CommRingCat.of R) to (CommRingCat.of S) diff --git a/Mathlib/Algebra/Category/Semigrp/Basic.lean b/Mathlib/Algebra/Category/Semigrp/Basic.lean index 6615692056446b..19774ca66c36b5 100644 --- a/Mathlib/Algebra/Category/Semigrp/Basic.lean +++ b/Mathlib/Algebra/Category/Semigrp/Basic.lean @@ -69,10 +69,11 @@ abbrev of (M : Type u) [Mul M] : MagmaCat := ⟨M⟩ end MagmaCat -mk_concrete_category MagmaCat (· →ₙ* ·) (MulHom.id ·) (MulHom.comp · ·) +@[to_additive AddMagmaCat] +mk_concrete_category MagmaCat (· →ₙ* ·) MulHom.id MulHom.comp with_of_hom {X Y : Type u} [Mul X] [Mul Y] hom_type (X →ₙ* Y) from (MagmaCat.of X) to (MagmaCat.of Y) - to_additive AddMagmaCat (· →ₙ+ ·) (AddHom.id ·) (AddHom.comp · ·) + to_additive AddMagmaCat (· →ₙ+ ·) AddHom.id AddHom.comp with_of_hom {X Y : Type u} [Add X] [Add Y] hom_type (X →ₙ+ Y) from (AddMagmaCat.of X) to (AddMagmaCat.of Y) @@ -176,10 +177,11 @@ abbrev of (M : Type u) [Semigroup M] : Semigrp := ⟨M⟩ end Semigrp -mk_concrete_category Semigrp (· →ₙ* ·) (MulHom.id ·) (MulHom.comp · ·) +@[to_additive AddSemigrp] +mk_concrete_category Semigrp (· →ₙ* ·) MulHom.id MulHom.comp with_of_hom {X Y : Type u} [Semigroup X] [Semigroup Y] hom_type (X →ₙ* Y) from (Semigrp.of X) to (Semigrp.of Y) - to_additive AddSemigrp (· →ₙ+ ·) (AddHom.id ·) (AddHom.comp · ·) + to_additive AddSemigrp (· →ₙ+ ·) AddHom.id AddHom.comp with_of_hom {X Y : Type u} [AddSemigroup X] [AddSemigroup Y] hom_type (X →ₙ+ Y) from (AddSemigrp.of X) to (AddSemigrp.of Y) diff --git a/Mathlib/Topology/Category/TopCat/Basic.lean b/Mathlib/Topology/Category/TopCat/Basic.lean index 61662a5982d751..edc7d6b9a72e66 100644 --- a/Mathlib/Topology/Category/TopCat/Basic.lean +++ b/Mathlib/Topology/Category/TopCat/Basic.lean @@ -64,7 +64,7 @@ lemma coe_of (X : Type u) [TopologicalSpace X] : (of X : Type u) = X := lemma of_carrier (X : TopCat.{u}) : of X = X := rfl -mk_concrete_category TopCat (fun X Y => C(X, Y)) (ContinuousMap.id ·) (ContinuousMap.comp · ·) +mk_concrete_category TopCat C(·, ·) ContinuousMap.id ContinuousMap.comp with_of_hom {X Y : Type u} [TopologicalSpace X] [TopologicalSpace Y] hom_type C(X, Y) from (TopCat.of X) to (TopCat.of Y) From c01206991bf404fed04e7e7f04d257bbb8dd8d0a Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 14:46:39 -0600 Subject: [PATCH 17/34] ProfiniteGrp --- .../Algebra/Category/ProfiniteGrp/Basic.lean | 68 ++++--------------- 1 file changed, 12 insertions(+), 56 deletions(-) diff --git a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean index d9d772218efd43..aba12f3b4760fa 100644 --- a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean +++ b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean @@ -10,6 +10,7 @@ public import Mathlib.Topology.Algebra.Group.ClosedSubgroup public import Mathlib.Topology.Algebra.ContinuousMonoidHom public import Mathlib.Topology.Category.Profinite.Basic public import Mathlib.Topology.Separation.Connected +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category of Profinite Groups @@ -90,48 +91,17 @@ lemma ProfiniteGrp.coe_of (G : Type u) [Group G] [TopologicalSpace G] [IsTopolog [CompactSpace G] [TotallyDisconnectedSpace G] : (ProfiniteGrp.of G : Type u) = G := rfl -/-- The type of morphisms in `ProfiniteAddGrp`. -/ -@[ext] -structure ProfiniteAddGrp.Hom (A B : ProfiniteAddGrp.{u}) where - private mk :: - /-- The underlying `ContinuousAddMonoidHom`. -/ - hom' : A →ₜ+ B - -/-- The type of morphisms in `ProfiniteGrp`. -/ -@[to_additive existing (attr := ext)] -structure ProfiniteGrp.Hom (A B : ProfiniteGrp.{u}) where - private mk :: - /-- The underlying `ContinuousMonoidHom`. -/ - hom' : A →ₜ* B - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : Category ProfiniteGrp where - Hom A B := ProfiniteGrp.Hom A B - id A := ⟨ContinuousMonoidHom.id A⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -@[to_additive] -instance : ConcreteCategory ProfiniteGrp (fun X Y => X →ₜ* Y) where - hom f := f.hom' - ofHom f := ⟨f⟩ - -/-- The underlying `ContinuousMonoidHom`. -/ -@[to_additive /-- The underlying `ContinuousAddMonoidHom`. -/] -abbrev ProfiniteGrp.Hom.hom {M N : ProfiniteGrp.{u}} (f : ProfiniteGrp.Hom M N) : - M →ₜ* N := - ConcreteCategory.hom (C := ProfiniteGrp) f - -/-- Typecheck a `ContinuousMonoidHom` as a morphism in `ProfiniteGrp`. -/ -@[to_additive /-- Typecheck a `ContinuousAddMonoidHom` as a morphism in `ProfiniteAddGrp`. -/] -abbrev ProfiniteGrp.ofHom {X Y : Type u} [Group X] [TopologicalSpace X] [IsTopologicalGroup X] - [CompactSpace X] [TotallyDisconnectedSpace X] [Group Y] [TopologicalSpace Y] - [IsTopologicalGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] - (f : X →ₜ* Y) : ProfiniteGrp.of X ⟶ ProfiniteGrp.of Y := - ConcreteCategory.ofHom f +@[to_additive ProfiniteAddGrp] +mk_concrete_category ProfiniteGrp (· →ₜ* ·) ContinuousMonoidHom.id ContinuousMonoidHom.comp + with_of_hom {X Y : Type u} [Group X] [TopologicalSpace X] [IsTopologicalGroup X] + [CompactSpace X] [TotallyDisconnectedSpace X] [Group Y] [TopologicalSpace Y] + [IsTopologicalGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] + hom_type (X →ₜ* Y) from (ProfiniteGrp.of X) to (ProfiniteGrp.of Y) + to_additive ProfiniteAddGrp (· →ₜ+ ·) ContinuousAddMonoidHom.id ContinuousAddMonoidHom.comp + with_of_hom {X Y : Type u} [AddGroup X] [TopologicalSpace X] [IsTopologicalAddGroup X] + [CompactSpace X] [TotallyDisconnectedSpace X] [AddGroup Y] [TopologicalSpace Y] + [IsTopologicalAddGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] + hom_type (X →ₜ+ Y) from (ProfiniteAddGrp.of X) to (ProfiniteAddGrp.of Y) namespace ProfiniteGrp @@ -139,18 +109,11 @@ namespace ProfiniteGrp instance {M N : ProfiniteGrp.{u}} : CoeFun (M ⟶ N) (fun _ ↦ M → N) where coe f := f.hom -@[to_additive (attr := simp)] -lemma hom_id {A : ProfiniteGrp.{u}} : (𝟙 A : A ⟶ A).hom = ContinuousMonoidHom.id A := rfl - /- Provided for rewriting. -/ @[to_additive] lemma id_apply (A : ProfiniteGrp.{u}) (a : A) : (𝟙 A : A ⟶ A) a = a := by simp -@[to_additive (attr := simp)] -lemma hom_comp {A B C : ProfiniteGrp.{u}} (f : A ⟶ B) (g : B ⟶ C) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ @[to_additive] lemma comp_apply {A B C : ProfiniteGrp.{u}} (f : A ⟶ B) (g : B ⟶ C) (a : A) : @@ -166,13 +129,6 @@ variable {X Y Z : Type u} [Group X] [TopologicalSpace X] [IsTopologicalGroup X] [IsTopologicalGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] [Group Z] [TopologicalSpace Z] [IsTopologicalGroup Z] [CompactSpace Z] [TotallyDisconnectedSpace Z] -@[to_additive (attr := simp)] -lemma hom_ofHom (f : X →ₜ* Y) : (ofHom f).hom = f := rfl - -@[to_additive (attr := simp)] -lemma ofHom_hom {A B : ProfiniteGrp.{u}} (f : A ⟶ B) : - ofHom (Hom.hom f) = f := rfl - @[to_additive (attr := simp)] lemma ofHom_id : ofHom (ContinuousMonoidHom.id X) = 𝟙 (of X) := rfl From b400ddf4c40f43470b463b8593c0bba2ee73d569 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 14:54:13 -0600 Subject: [PATCH 18/34] UniformSpaceCat --- Mathlib/Algebra/Category/BoolRing.lean | 1 - Mathlib/Algebra/Category/Grp/Basic.lean | 1 - Mathlib/Algebra/Category/ModuleCat/Basic.lean | 1 - Mathlib/Algebra/Category/Ring/Basic.lean | 1 - .../Algebra/Category/ProfiniteGrp/Basic.lean | 1 - Mathlib/Topology/Category/UniformSpace.lean | 51 +++---------------- 6 files changed, 7 insertions(+), 49 deletions(-) diff --git a/Mathlib/Algebra/Category/BoolRing.lean b/Mathlib/Algebra/Category/BoolRing.lean index 0f183f6b59880f..9d1eccb0b40fb3 100644 --- a/Mathlib/Algebra/Category/BoolRing.lean +++ b/Mathlib/Algebra/Category/BoolRing.lean @@ -8,7 +8,6 @@ module public import Mathlib.Algebra.Category.Ring.Basic public import Mathlib.Algebra.Ring.BooleanRing public import Mathlib.Order.Category.BoolAlg -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of Boolean rings diff --git a/Mathlib/Algebra/Category/Grp/Basic.lean b/Mathlib/Algebra/Category/Grp/Basic.lean index 4c69f57c38361b..406fc075cda127 100644 --- a/Mathlib/Algebra/Category/Grp/Basic.lean +++ b/Mathlib/Algebra/Category/Grp/Basic.lean @@ -9,7 +9,6 @@ public import Mathlib.Algebra.Category.MonCat.Basic public import Mathlib.Algebra.Group.End public import Mathlib.CategoryTheory.Endomorphism public import Mathlib.Data.Int.Cast.Lemmas -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for Group, AddGroup, CommGroup, and AddCommGroup. diff --git a/Mathlib/Algebra/Category/ModuleCat/Basic.lean b/Mathlib/Algebra/Category/ModuleCat/Basic.lean index 6a5c7ff9e4f92f..f14d53e068df90 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Basic.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Basic.lean @@ -9,7 +9,6 @@ public import Mathlib.Algebra.Category.ModuleCat.Semi public import Mathlib.Algebra.Category.Grp.Preadditive public import Mathlib.CategoryTheory.Linear.Basic public import Mathlib.CategoryTheory.Preadditive.AdditiveFunctor -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of `R`-modules diff --git a/Mathlib/Algebra/Category/Ring/Basic.lean b/Mathlib/Algebra/Category/Ring/Basic.lean index 285e941cab34d7..b97c647788e152 100644 --- a/Mathlib/Algebra/Category/Ring/Basic.lean +++ b/Mathlib/Algebra/Category/Ring/Basic.lean @@ -8,7 +8,6 @@ module public import Mathlib.Algebra.Category.Grp.Basic public import Mathlib.Algebra.Ring.Equiv public import Mathlib.Algebra.Ring.PUnit -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category instances for `Semiring`, `Ring`, `CommSemiring`, and `CommRing`. diff --git a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean index aba12f3b4760fa..de539788f36a51 100644 --- a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean +++ b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean @@ -10,7 +10,6 @@ public import Mathlib.Topology.Algebra.Group.ClosedSubgroup public import Mathlib.Topology.Algebra.ContinuousMonoidHom public import Mathlib.Topology.Category.Profinite.Basic public import Mathlib.Topology.Separation.Connected -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category of Profinite Groups diff --git a/Mathlib/Topology/Category/UniformSpace.lean b/Mathlib/Topology/Category/UniformSpace.lean index 3cfb33de484fce..9bff8b745eceb7 100644 --- a/Mathlib/Topology/Category/UniformSpace.lean +++ b/Mathlib/Topology/Category/UniformSpace.lean @@ -42,37 +42,15 @@ namespace UniformSpaceCat instance : CoeSort UniformSpaceCat Type* := ⟨carrier⟩ -/-- A bundled uniform continuous map. -/ -@[ext] -structure Hom (X Y : UniformSpaceCat) where - /-- The underlying `UniformContinuous` function. -/ - hom' : { f : X → Y // UniformContinuous f } - -instance : LargeCategory.{u} UniformSpaceCat.{u} where - Hom := Hom - id X := ⟨id, uniformContinuous_id⟩ - comp f g := ⟨⟨g.hom'.val ∘ f.hom'.val, g.hom'.property.comp f.hom'.property⟩⟩ - id_comp := by intros; apply Hom.ext; simp - comp_id := by intros; apply Hom.ext; simp - assoc := by intros; apply Hom.ext; ext; simp - instance instFunLike (X Y : UniformSpaceCat) : FunLike { f : X → Y // UniformContinuous f } X Y where coe := Subtype.val coe_injective' _ _ h := Subtype.ext h -instance : ConcreteCategory UniformSpaceCat ({ f : · → · // UniformContinuous f }) where - hom f := f.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `UniformSpaceCat` back into a function which is `UniformContinuous`. -/ -abbrev Hom.hom {X Y : UniformSpaceCat} (f : Hom X Y) := - ConcreteCategory.hom (C := UniformSpaceCat) f - -/-- Typecheck a function which is `UniformContinuous` as a morphism in `UniformSpaceCat`. -/ -abbrev ofHom {X Y : Type u} [UniformSpace X] [UniformSpace Y] - (f : { f : X → Y // UniformContinuous f }) : of X ⟶ of Y := - ConcreteCategory.ofHom f +mk_concrete_category UniformSpaceCat ({ f : · → · // UniformContinuous f }) + (fun _ ↦ ⟨id, uniformContinuous_id⟩) (fun g f ↦ ⟨g ∘ f, g.property.comp f.property⟩) + with_of_hom {X Y : Type u} [UniformSpace X] [UniformSpace Y] + hom_type { f : X → Y // UniformContinuous f } from (of X) to (of Y) instance : Inhabited UniformSpaceCat := ⟨UniformSpaceCat.of Empty⟩ @@ -80,20 +58,6 @@ instance : Inhabited UniformSpaceCat := theorem coe_of (X : Type u) [UniformSpace X] : (of X : Type u) = X := rfl -@[simp] -theorem hom_comp {X Y Z : UniformSpaceCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = ⟨g ∘ f, g.hom.prop.comp f.hom.prop⟩ := - rfl - -@[simp] -theorem hom_id (X : UniformSpaceCat) : (𝟙 X : X ⟶ X).hom = ⟨id, uniformContinuous_id⟩ := - rfl - -@[simp] -theorem hom_ofHom {X Y : Type u} [UniformSpace X] [UniformSpace Y] - (f : { f : X → Y // UniformContinuous f }) : (ofHom f).hom = f := - rfl - theorem coe_comp {X Y Z : UniformSpaceCat} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f := rfl @@ -101,7 +65,7 @@ theorem coe_id (X : UniformSpaceCat) : (𝟙 X : X → X) = id := rfl theorem coe_mk {X Y : UniformSpaceCat} (f : X → Y) (hf : UniformContinuous f) : - (⟨f, hf⟩ : X ⟶ Y).hom = f := + ((ofHom ⟨f, hf⟩ : X ⟶ Y).hom : X → Y) = f := rfl @[ext] @@ -206,9 +170,8 @@ noncomputable def completionFunctor : UniformSpaceCat ⥤ CpltSepUniformSpace wh /-- The inclusion of a uniform space into its completion. -/ noncomputable def completionHom (X : UniformSpaceCat) : - X ⟶ (forget₂ CpltSepUniformSpace UniformSpaceCat).obj (completionFunctor.obj X) where - hom'.val := ((↑) : X → Completion X) - hom'.property := Completion.uniformContinuous_coe X + X ⟶ (forget₂ CpltSepUniformSpace UniformSpaceCat).obj (completionFunctor.obj X) := + ofHom ⟨((↑) : X → Completion X), Completion.uniformContinuous_coe X⟩ @[simp] theorem completionHom_val (X : UniformSpaceCat) (x) : (completionHom X) x = (x : Completion X) := From 25b0209ece0a174d2d29fb6c3a3530837dd06fea Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 15:10:04 -0600 Subject: [PATCH 19/34] more categories --- Mathlib/Algebra/Category/AlgCat/Basic.lean | 56 +----------------- .../Algebra/Category/CommAlgCat/Basic.lean | 41 +------------ Mathlib/Algebra/Category/CommBialgCat.lean | 42 +------------ Mathlib/Algebra/Category/ModuleCat/Semi.lean | 1 - .../Category/ModuleCat/Topology/Basic.lean | 55 ++--------------- .../Analysis/Normed/Group/SemiNormedGrp.lean | 49 ++------------- Mathlib/Order/Category/BddDistLat.lean | 59 ++----------------- Mathlib/Order/Category/BddLat.lean | 47 ++------------- Mathlib/Order/Category/BddOrd.lean | 56 ++---------------- Mathlib/Order/Category/BoolAlg.lean | 56 ++---------------- Mathlib/Order/Category/DistLat.lean | 56 ++---------------- Mathlib/Order/Category/FinBddDistLat.lean | 59 ++----------------- Mathlib/Order/Category/Frm.lean | 52 +--------------- Mathlib/Order/Category/HeytAlg.lean | 56 ++---------------- Mathlib/Order/Category/Lat.lean | 53 +---------------- Mathlib/Order/Category/LinOrd.lean | 53 +---------------- Mathlib/Order/Category/PartOrd.lean | 52 +--------------- Mathlib/Order/Category/PartOrdEmb.lean | 52 +--------------- Mathlib/Order/Category/Preord.lean | 52 ++-------------- Mathlib/RepresentationTheory/Rep/Basic.lean | 46 ++------------- 20 files changed, 73 insertions(+), 920 deletions(-) diff --git a/Mathlib/Algebra/Category/AlgCat/Basic.lean b/Mathlib/Algebra/Category/AlgCat/Basic.lean index d3214a41db5eb1..7a70de998b495e 100644 --- a/Mathlib/Algebra/Category/AlgCat/Basic.lean +++ b/Mathlib/Algebra/Category/AlgCat/Basic.lean @@ -57,60 +57,18 @@ lemma coe_of (X : Type v) [Ring X] [Algebra R X] : (of R X : Type v) = X := rfl variable {R} in -set_option backward.privateInPublic true in -/-- The type of morphisms in `AlgCat R`. -/ -@[ext] -structure Hom (A B : AlgCat.{v} R) where - private mk :: - /-- The underlying algebra map. -/ - hom' : A →ₐ[R] B - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category (AlgCat.{v} R) where - Hom A B := Hom A B - id A := ⟨AlgHom.id R A⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (AlgCat.{v} R) (· →ₐ[R] ·) where - hom := Hom.hom' - ofHom := Hom.mk - -variable {R} in -/-- Turn a morphism in `AlgCat` back into an `AlgHom`. -/ -abbrev Hom.hom {A B : AlgCat.{v} R} (f : Hom A B) := - ConcreteCategory.hom (C := AlgCat R) f - -variable {R} in -/-- Typecheck an `AlgHom` as a morphism in `AlgCat`. -/ -abbrev ofHom {A B : Type v} [Ring A] [Ring B] [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) : - of R A ⟶ of R B := - ConcreteCategory.ofHom (C := AlgCat R) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : AlgCat.{v} R) (f : Hom A B) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category (AlgCat.{v} R) (· →ₐ[R] ·) (AlgHom.id R) AlgHom.comp + with_of_hom {A B : Type v} [Ring A] [Ring B] [Algebra R A] [Algebra R B] + hom_type (A →ₐ[R] B) from (of R A) to (of R B) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] -lemma hom_id {A : AlgCat.{v} R} : (𝟙 A : A ⟶ A).hom = AlgHom.id R A := rfl - /- Provided for rewriting. -/ lemma id_apply (A : AlgCat.{v} R) (a : A) : (𝟙 A : A ⟶ A) a = a := by simp -@[simp] -lemma hom_comp {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) (a : A) : (f ≫ g) a = g (f a) := by simp @@ -119,14 +77,6 @@ lemma comp_apply {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) (a : A) : lemma hom_ext {A B : AlgCat.{v} R} {f g : A ⟶ B} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {R : Type u} [CommRing R] {X Y : Type v} [Ring X] [Algebra R X] [Ring Y] - [Algebra R Y] (f : X →ₐ[R] Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {A B : AlgCat.{v} R} (f : A ⟶ B) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type v} [Ring X] [Algebra R X] : ofHom (AlgHom.id R X) = 𝟙 (of R X) := rfl diff --git a/Mathlib/Algebra/Category/CommAlgCat/Basic.lean b/Mathlib/Algebra/Category/CommAlgCat/Basic.lean index 890af256ec28cc..0a5146f99ed543 100644 --- a/Mathlib/Algebra/Category/CommAlgCat/Basic.lean +++ b/Mathlib/Algebra/Category/CommAlgCat/Basic.lean @@ -57,57 +57,22 @@ abbrev of (X : Type v) [CommRing X] [Algebra R X] : CommAlgCat.{v} R := ⟨X⟩ variable (R) in lemma coe_of (X : Type v) [CommRing X] [Algebra R X] : (of R X : Type v) = X := rfl -set_option backward.privateInPublic true in -/-- The type of morphisms in `CommAlgCat R`. -/ -@[ext] -structure Hom (A B : CommAlgCat.{v} R) where - private mk :: - /-- The underlying algebra map. -/ - hom' : A →ₐ[R] B - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category (CommAlgCat.{v} R) where - Hom A B := Hom A B - id A := ⟨AlgHom.id R A⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (CommAlgCat.{v} R) (· →ₐ[R] ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `CommAlgCat` back into an `AlgHom`. -/ -abbrev Hom.hom (f : Hom A B) := ConcreteCategory.hom (C := CommAlgCat R) f - -/-- Typecheck an `AlgHom` as a morphism in `CommAlgCat`. -/ -abbrev ofHom (f : X →ₐ[R] Y) : of R X ⟶ of R Y := ConcreteCategory.ofHom (C := CommAlgCat R) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : CommAlgCat.{v} R) (f : Hom A B) := f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category (CommAlgCat.{v} R) (· →ₐ[R] ·) (AlgHom.id R) AlgHom.comp + with_of_hom {X Y : Type v} [CommRing X] [Algebra R X] [CommRing Y] [Algebra R Y] + hom_type (X →ₐ[R] Y) from (of R X) to (of R Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] lemma hom_id : (𝟙 A : A ⟶ A).hom = AlgHom.id R A := rfl - /- Provided for rewriting. -/ lemma id_apply (A : CommAlgCat.{v} R) (a : A) : (𝟙 A : A ⟶ A) a = a := by simp -@[simp] lemma hom_comp (f : A ⟶ B) (g : B ⟶ C) : (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply (f : A ⟶ B) (g : B ⟶ C) (a : A) : (f ≫ g) a = g (f a) := by simp @[ext] lemma hom_ext {f g : A ⟶ B} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] lemma hom_ofHom (f : X →ₐ[R] Y) : (ofHom f).hom = f := rfl -@[simp] lemma ofHom_hom (f : A ⟶ B) : ofHom f.hom = f := rfl - @[simp] lemma ofHom_id : ofHom (.id R X) = 𝟙 (of R X) := rfl @[simp] diff --git a/Mathlib/Algebra/Category/CommBialgCat.lean b/Mathlib/Algebra/Category/CommBialgCat.lean index 6847dd716488ca..78506e5e268029 100644 --- a/Mathlib/Algebra/Category/CommBialgCat.lean +++ b/Mathlib/Algebra/Category/CommBialgCat.lean @@ -59,55 +59,19 @@ abbrev of (X : Type v) [CommRing X] [Bialgebra R X] : CommBialgCat.{v} R := ⟨X variable (R) in lemma coe_of (X : Type v) [CommRing X] [Bialgebra R X] : (of R X : Type v) = X := rfl -set_option backward.privateInPublic true in -/-- The type of morphisms in `CommBialgCat R`. -/ -@[ext] -structure Hom (A B : CommBialgCat.{v} R) where - private mk :: - /-- The underlying bialgebra map. -/ - hom' : A →ₐc[R] B - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category (CommBialgCat.{v} R) where - Hom A B := Hom A B - id A := ⟨.id R A⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (CommBialgCat.{v} R) (· →ₐc[R] ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `CommBialgCat` back into a `BialgHom`. -/ -abbrev Hom.hom (f : Hom A B) : A →ₐc[R] B := ConcreteCategory.hom (C := CommBialgCat R) f - -/-- Typecheck a `BialgHom` as a morphism in `CommBialgCat R`. -/ -abbrev ofHom {X Y : Type v} {_ : CommRing X} {_ : CommRing Y} {_ : Bialgebra R X} - {_ : Bialgebra R Y} (f : X →ₐc[R] Y) : of R X ⟶ of R Y := - ConcreteCategory.ofHom (C := CommBialgCat R) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : CommBialgCat.{v} R) (f : Hom A B) := f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category (CommBialgCat.{v} R) (· →ₐc[R] ·) (BialgHom.id R) BialgHom.comp + with_of_hom {X Y : Type v} [CommRing X] [Bialgebra R X] [CommRing Y] [Bialgebra R Y] + hom_type (X →ₐc[R] Y) from (of R X) to (of R Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] lemma hom_id : (𝟙 A : A ⟶ A).hom = AlgHom.id R A := rfl -@[simp] lemma hom_comp (f : A ⟶ B) (g : B ⟶ C) : (f ≫ g).hom = g.hom.comp f.hom := rfl - lemma id_apply (A : CommBialgCat.{v} R) (a : A) : (𝟙 A : A ⟶ A) a = a := by simp lemma comp_apply (f : A ⟶ B) (g : B ⟶ C) (a : A) : (f ≫ g) a = g (f a) := by simp @[ext] lemma hom_ext {f g : A ⟶ B} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] lemma hom_ofHom (f : X →ₐc[R] Y) : (ofHom f).hom = f := rfl -@[simp] lemma ofHom_hom (f : A ⟶ B) : ofHom f.hom = f := rfl - @[simp] lemma ofHom_id : ofHom (.id R X) = 𝟙 (of R X) := rfl @[simp] diff --git a/Mathlib/Algebra/Category/ModuleCat/Semi.lean b/Mathlib/Algebra/Category/ModuleCat/Semi.lean index abd890e906937d..2a968fbb158d76 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Semi.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Semi.lean @@ -12,7 +12,6 @@ public import Mathlib.Algebra.Module.Equiv.Basic public import Mathlib.Algebra.Module.PUnit public import Mathlib.CategoryTheory.Conj public import Mathlib.CategoryTheory.Limits.Shapes.ZeroMorphisms -public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of `R`-modules diff --git a/Mathlib/Algebra/Category/ModuleCat/Topology/Basic.lean b/Mathlib/Algebra/Category/ModuleCat/Topology/Basic.lean index dfaf716fa6de94..c7f2316ccfdbb3 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Topology/Basic.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Topology/Basic.lean @@ -59,60 +59,13 @@ abbrev of (M : Type v) [AddCommGroup M] [Module R M] [TopologicalSpace M] [Conti lemma coe_of (M : Type v) [AddCommGroup M] [Module R M] [TopologicalSpace M] [ContinuousAdd M] [ContinuousSMul R M] : (of R M) = M := rfl -set_option backward.privateInPublic true in -variable {R} in -/-- Homs in `TopModuleCat` as one field structures over `ContinuousLinearMap`. -/ -structure Hom (X Y : TopModuleCat.{v} R) where - -- use `ofHom` instead - private ofHom' :: - /-- The underlying continuous linear map. Use `hom` instead. -/ - hom' : X →L[R] Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category (TopModuleCat R) where - Hom := Hom - id M := ⟨ContinuousLinearMap.id R M⟩ - comp φ ψ := ⟨ψ.hom' ∘L φ.hom'⟩ - -set_option linter.style.whitespace false in -- manual alignment is not recognised -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (TopModuleCat R) (· →L[R] ·) where - hom := Hom.hom' - ofHom := Hom.ofHom' - variable {R} in -/-- Cast a hom in `TopModuleCat` into a continuous linear map. -/ -abbrev Hom.hom {X Y : TopModuleCat R} (f : X.Hom Y) : X →L[R] Y := - ConcreteCategory.hom (C := TopModuleCat R) f - -variable {R} in -/-- Construct a hom in `TopModuleCat` from a continuous linear map. -/ -abbrev ofHom {X Y : Type v} +mk_concrete_category (TopModuleCat.{v} R) (· →L[R] ·) + (fun (M : TopModuleCat.{v} R) ↦ ContinuousLinearMap.id R M) ContinuousLinearMap.comp + with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [TopologicalSpace X] [ContinuousAdd X] [ContinuousSMul R X] [AddCommGroup Y] [Module R Y] [TopologicalSpace Y] [ContinuousAdd Y] [ContinuousSMul R Y] - (f : X →L[R] Y) : of R X ⟶ of R Y := - ConcreteCategory.ofHom f - -@[simp] lemma hom_ofHom {X Y : Type v} - [AddCommGroup X] [Module R X] [TopologicalSpace X] [ContinuousAdd X] [ContinuousSMul R X] - [AddCommGroup Y] [Module R Y] [TopologicalSpace Y] [ContinuousAdd Y] [ContinuousSMul R Y] - (f : X →L[R] Y) : - (ofHom f).hom = f := rfl - -@[simp] lemma ofHom_hom {X Y : TopModuleCat R} (f : X.Hom Y) : ofHom f.hom = f := rfl - -@[simp] lemma hom_comp {X Y Z : TopModuleCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - -@[simp] lemma hom_id (X : TopModuleCat R) : hom (𝟙 X) = .id _ _ := rfl - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (A B : TopModuleCat.{v} R) (f : A.Hom B) := - f.hom - -initialize_simps_projections Hom (hom' → hom) + hom_type (X →L[R] Y) from (of R X) to (of R Y) variable {R} in /-- Construct an iso in `TopModuleCat` from a continuous linear equiv. -/ diff --git a/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean b/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean index 9340a9f55f8c3a..0b8f894a8d4fdb 100644 --- a/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean +++ b/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean @@ -9,6 +9,7 @@ public import Mathlib.Analysis.Normed.Group.Constructions public import Mathlib.Analysis.Normed.Group.Hom public import Mathlib.CategoryTheory.ConcreteCategory.Forget public import Mathlib.CategoryTheory.Limits.Shapes.ZeroMorphisms +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # The category of seminormed groups @@ -41,35 +42,10 @@ namespace SemiNormedGrp instance : CoeSort SemiNormedGrp Type* where coe X := X.carrier -/-- The type of morphisms in `SemiNormedGrp` -/ -@[ext] -structure Hom (M N : SemiNormedGrp.{u}) where - /-- The underlying `NormedAddGroupHom`. -/ - hom' : NormedAddGroupHom M N - -instance : LargeCategory.{u} SemiNormedGrp where - Hom X Y := Hom X Y - id X := ⟨NormedAddGroupHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -instance : ConcreteCategory SemiNormedGrp (NormedAddGroupHom · ·) where - hom f := f.hom' - ofHom f := ⟨f⟩ - -/-- Turn a morphism in `SemiNormedGrp` back into a `NormedAddGroupHom`. -/ -abbrev Hom.hom {M N : SemiNormedGrp.{u}} (f : Hom M N) := - ConcreteCategory.hom (C := SemiNormedGrp) f - -/-- Typecheck a `NormedAddGroupHom` as a morphism in `SemiNormedGrp`. -/ -abbrev ofHom {M N : Type u} [SeminormedAddCommGroup M] [SeminormedAddCommGroup N] - (f : NormedAddGroupHom M N) : of M ⟶ of N := - ConcreteCategory.ofHom (C := SemiNormedGrp) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (M N : SemiNormedGrp.{u}) (f : Hom M N) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category SemiNormedGrp (NormedAddGroupHom · ·) + NormedAddGroupHom.id NormedAddGroupHom.comp + with_of_hom {M N : Type u} [SeminormedAddCommGroup M] [SeminormedAddCommGroup N] + hom_type (NormedAddGroupHom M N) from (of M) to (of N) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -78,17 +54,10 @@ The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep lemma ext {M N : SemiNormedGrp} {f₁ f₂ : M ⟶ N} (h : ∀ (x : M), f₁ x = f₂ x) : f₁ = f₂ := ConcreteCategory.ext_apply h -@[simp] -lemma hom_id {M : SemiNormedGrp} : (𝟙 M : M ⟶ M).hom = NormedAddGroupHom.id M := rfl - /- Provided for rewriting. -/ lemma id_apply (M : SemiNormedGrp) (r : M) : (𝟙 M : M ⟶ M) r = r := by simp -@[simp] -lemma hom_comp {M N O : SemiNormedGrp} (f : M ⟶ N) (g : N ⟶ O) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {M N O : SemiNormedGrp} (f : M ⟶ N) (g : N ⟶ O) (r : M) : (f ≫ g) r = g (f r) := by simp @@ -97,14 +66,6 @@ lemma comp_apply {M N O : SemiNormedGrp} (f : M ⟶ N) (g : N ⟶ O) (r : M) : lemma hom_ext {M N : SemiNormedGrp} {f g : M ⟶ N} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {M N : Type u} [SeminormedAddCommGroup M] [SeminormedAddCommGroup N] - (f : NormedAddGroupHom M N) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {M N : SemiNormedGrp} (f : M ⟶ N) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {M : Type u} [SeminormedAddCommGroup M] : ofHom (NormedAddGroupHom.id M) = 𝟙 (of M) := rfl diff --git a/Mathlib/Order/Category/BddDistLat.lean b/Mathlib/Order/Category/BddDistLat.lean index f8d8b199964fdf..8e6998dc166f17 100644 --- a/Mathlib/Order/Category/BddDistLat.lean +++ b/Mathlib/Order/Category/BddDistLat.lean @@ -48,43 +48,11 @@ abbrev of (α : Type*) [DistribLattice α] [BoundedOrder α] : BddDistLat where theorem coe_of (α : Type*) [DistribLattice α] [BoundedOrder α] : ↥(of α) = α := rfl -set_option backward.privateInPublic true in -/-- The type of morphisms in `BddDistLat R`. -/ -@[ext] -structure Hom (X Y : BddDistLat.{u}) where - private mk :: - /-- The underlying `BoundedLatticeHom`. -/ - hom' : BoundedLatticeHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category BddDistLat.{u} where - Hom X Y := Hom X Y - id X := ⟨BoundedLatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory BddDistLat (BoundedLatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `BddDistLat` back into a `BoundedLatticeHom`. -/ -abbrev Hom.hom {X Y : BddDistLat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := BddDistLat) f - -/-- Typecheck a `BoundedLatticeHom` as a morphism in `BddDistLat`. -/ -abbrev ofHom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [DistribLattice Y] [BoundedOrder Y] - (f : BoundedLatticeHom X Y) : - of X ⟶ of Y := - ConcreteCategory.ofHom (C := BddDistLat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : BddDistLat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category BddDistLat (BoundedLatticeHom · ·) + (fun (X : BddDistLat) ↦ BoundedLatticeHom.id X) + BoundedLatticeHom.comp + with_of_hom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [DistribLattice Y] + [BoundedOrder Y] hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -104,17 +72,10 @@ lemma forget_map {X Y : BddDistLat} (f : X ⟶ Y) : lemma ext {X Y : BddDistLat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := ConcreteCategory.hom_ext _ _ w -@[simp] -lemma hom_id {X : BddDistLat} : (𝟙 X : X ⟶ X).hom = BoundedLatticeHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : BddDistLat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : BddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : BddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -123,16 +84,6 @@ lemma comp_apply {X Y Z : BddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : BddDistLat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [DistribLattice Y] - [BoundedOrder Y] (f : BoundedLatticeHom X Y) : - (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : BddDistLat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [DistribLattice X] [BoundedOrder X] : ofHom (BoundedLatticeHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/BddLat.lean b/Mathlib/Order/Category/BddLat.lean index 508c5f4f137be2..86a5e2ab5c9dfc 100644 --- a/Mathlib/Order/Category/BddLat.lean +++ b/Mathlib/Order/Category/BddLat.lean @@ -48,57 +48,18 @@ abbrev of (α : Type*) [Lattice α] [BoundedOrder α] : BddLat where theorem coe_of (α : Type*) [Lattice α] [BoundedOrder α] : ↥(of α) = α := rfl -set_option backward.privateInPublic true in -/-- The type of morphisms in `BddLat`. -/ -@[ext] -structure Hom (X Y : BddLat.{u}) where - private mk :: - /-- The underlying `BoundedLatticeHom`. -/ - hom' : BoundedLatticeHom X Y - instance : Inhabited BddLat := ⟨of PUnit⟩ -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : LargeCategory.{u} BddLat where - Hom := Hom - id X := ⟨BoundedLatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory BddLat (BoundedLatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `BddLat` back into a `BoundedLatticeHom`. -/ -abbrev Hom.hom {X Y : BddLat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := BddLat) f - -/-- Typecheck a `BoundedLatticeHom` as a morphism in `BddLat`. -/ -abbrev ofHom {X Y : Type u} [Lattice X] [BoundedOrder X] [Lattice Y] [BoundedOrder Y] - (f : BoundedLatticeHom X Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := BddLat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : BddLat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) - -@[simp] -lemma hom_id {X : Lat} : (𝟙 X : X ⟶ X).hom = LatticeHom.id _ := rfl +mk_concrete_category BddLat (BoundedLatticeHom · ·) (fun (X : BddLat) ↦ BoundedLatticeHom.id X) + BoundedLatticeHom.comp + with_of_hom {X Y : Type u} [Lattice X] [BoundedOrder X] [Lattice Y] [BoundedOrder Y] + hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) /- Provided for rewriting. -/ lemma id_apply (X : Lat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : Lat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : Lat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp diff --git a/Mathlib/Order/Category/BddOrd.lean b/Mathlib/Order/Category/BddOrd.lean index fbda8a11919aec..8f8717c42f63b1 100644 --- a/Mathlib/Order/Category/BddOrd.lean +++ b/Mathlib/Order/Category/BddOrd.lean @@ -42,42 +42,10 @@ instance : CoeSort BddOrd Type* := abbrev of (X : Type*) [PartialOrder X] [BoundedOrder X] : BddOrd where carrier := X -set_option backward.privateInPublic true in -/-- The type of morphisms in `BddOrd R`. -/ -@[ext] -structure Hom (X Y : BddOrd.{u}) where - private mk :: - /-- The underlying `BoundedOrderHom`. -/ - hom' : BoundedOrderHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category BddOrd.{u} where - Hom X Y := Hom X Y - id _ := ⟨BoundedOrderHom.id _⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory BddOrd (BoundedOrderHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `BddOrd` back into a `BoundedOrderHom`. -/ -abbrev Hom.hom {X Y : BddOrd.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := BddOrd) f - -/-- Typecheck a `BoundedOrderHom` as a morphism in `BddOrd`. -/ -abbrev ofHom {X Y : Type u} [PartialOrder X] [BoundedOrder X] [PartialOrder Y] [BoundedOrder Y] - (f : BoundedOrderHom X Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := BddOrd) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : BddOrd.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category BddOrd (BoundedOrderHom · ·) (fun (X : BddOrd) ↦ BoundedOrderHom.id X) + BoundedOrderHom.comp + with_of_hom {X Y : Type u} [PartialOrder X] [BoundedOrder X] [PartialOrder Y] + [BoundedOrder Y] hom_type (BoundedOrderHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -100,17 +68,10 @@ lemma ext {X Y : BddOrd} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [PartialOrder X] [BoundedOrder X] : (BddOrd.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : BddOrd} : (𝟙 X : X ⟶ X).hom = BoundedOrderHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : BddOrd) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : BddOrd} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : BddOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -119,15 +80,6 @@ lemma comp_apply {X Y Z : BddOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : BddOrd} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [PartialOrder X] [BoundedOrder X] [PartialOrder Y] [BoundedOrder Y] - (f : BoundedOrderHom X Y) : - (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {X Y : BddOrd} (f : X ⟶ Y) : - ofHom f.hom = f := rfl - @[simp] lemma ofHom_id {X : Type u} [PartialOrder X] [BoundedOrder X] : ofHom (BoundedOrderHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/BoolAlg.lean b/Mathlib/Order/Category/BoolAlg.lean index 2bd9e8a57f332d..6e70c94d7b6126 100644 --- a/Mathlib/Order/Category/BoolAlg.lean +++ b/Mathlib/Order/Category/BoolAlg.lean @@ -42,42 +42,10 @@ instance : CoeSort BoolAlg (Type _) := attribute [coe] BoolAlg.carrier -set_option backward.privateInPublic true in -/-- The type of morphisms in `BoolAlg R`. -/ -@[ext] -structure Hom (X Y : BoolAlg.{u}) where - private mk :: - /-- The underlying `BoundedLatticeHom`. -/ - hom' : BoundedLatticeHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category BoolAlg.{u} where - Hom X Y := Hom X Y - id X := ⟨BoundedLatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory BoolAlg (BoundedLatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `BoolAlg` back into a `BoundedLatticeHom`. -/ -abbrev Hom.hom {X Y : BoolAlg.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := BoolAlg) f - -/-- Typecheck a `BoundedLatticeHom` as a morphism in `BoolAlg`. -/ -abbrev ofHom {X Y : Type u} [BooleanAlgebra X] [BooleanAlgebra Y] (f : BoundedLatticeHom X Y) : - of X ⟶ of Y := - ConcreteCategory.ofHom (C := BoolAlg) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : BoolAlg.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category BoolAlg (BoundedLatticeHom · ·) (fun (X : BoolAlg) ↦ BoundedLatticeHom.id X) + BoundedLatticeHom.comp + with_of_hom {X Y : Type u} [BooleanAlgebra X] [BooleanAlgebra Y] + hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -100,17 +68,10 @@ lemma ext {X Y : BoolAlg} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [BooleanAlgebra X] : (BoolAlg.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : BoolAlg} : (𝟙 X : X ⟶ X).hom = BoundedLatticeHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : BoolAlg) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : BoolAlg} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : BoolAlg} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -119,15 +80,6 @@ lemma comp_apply {X Y Z : BoolAlg} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : BoolAlg} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [BooleanAlgebra X] [BooleanAlgebra Y] (f : BoundedLatticeHom X Y) : - (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : BoolAlg} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [BooleanAlgebra X] : ofHom (BoundedLatticeHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/DistLat.lean b/Mathlib/Order/Category/DistLat.lean index 53f247aa4385da..b5a44de695c712 100644 --- a/Mathlib/Order/Category/DistLat.lean +++ b/Mathlib/Order/Category/DistLat.lean @@ -44,42 +44,10 @@ attribute [coe] DistLat.carrier /-- Construct a bundled `DistLat` from the underlying type and typeclass. -/ abbrev of (X : Type*) [DistribLattice X] : DistLat := ⟨X⟩ -set_option backward.privateInPublic true in -/-- The type of morphisms in `DistLat R`. -/ -@[ext] -structure Hom (X Y : DistLat.{u}) where - private mk :: - /-- The underlying `LatticeHom`. -/ - hom' : LatticeHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category DistLat.{u} where - Hom X Y := Hom X Y - id X := ⟨LatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory DistLat (LatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `DistLat` back into a `LatticeHom`. -/ -abbrev Hom.hom {X Y : DistLat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := DistLat) f - -/-- Typecheck a `LatticeHom` as a morphism in `DistLat`. -/ -abbrev ofHom {X Y : Type u} [DistribLattice X] [DistribLattice Y] (f : LatticeHom X Y) : - of X ⟶ of Y := - ConcreteCategory.ofHom (C := DistLat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : DistLat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category DistLat (LatticeHom · ·) (fun (X : DistLat) ↦ LatticeHom.id X) + LatticeHom.comp + with_of_hom {X Y : Type u} [DistribLattice X] [DistribLattice Y] + hom_type (LatticeHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -102,17 +70,10 @@ lemma ext {X Y : DistLat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [DistribLattice X] : (DistLat.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : DistLat} : (𝟙 X : X ⟶ X).hom = LatticeHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : DistLat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : DistLat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : DistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -121,15 +82,6 @@ lemma comp_apply {X Y Z : DistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : DistLat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [DistribLattice X] [DistribLattice Y] (f : LatticeHom X Y) : - (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : DistLat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [DistribLattice X] : ofHom (LatticeHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/FinBddDistLat.lean b/Mathlib/Order/Category/FinBddDistLat.lean index 8a71f5e5a82168..bfc331aec8430f 100644 --- a/Mathlib/Order/Category/FinBddDistLat.lean +++ b/Mathlib/Order/Category/FinBddDistLat.lean @@ -49,44 +49,12 @@ abbrev of' (α : Type*) [DistribLattice α] [Fintype α] [Nonempty α] : FinBddD carrier := α isBoundedOrder := Fintype.toBoundedOrder α -set_option backward.privateInPublic true in -/-- The type of morphisms in `FinBddDistLat R`. -/ -@[ext] -structure Hom (X Y : FinBddDistLat.{u}) where - private mk :: - /-- The underlying `BoundedLatticeHom`. -/ - hom' : BoundedLatticeHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category FinBddDistLat.{u} where - Hom X Y := Hom X Y - id X := ⟨BoundedLatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory FinBddDistLat (BoundedLatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `FinBddDistLat` back into a `BoundedLatticeHom`. -/ -abbrev Hom.hom {X Y : FinBddDistLat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := FinBddDistLat) f - -/-- Typecheck a `BoundedLatticeHom` as a morphism in `FinBddDistLat`. -/ -abbrev ofHom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [Fintype X] [DistribLattice Y] - [BoundedOrder Y] [Fintype Y] - (f : BoundedLatticeHom X Y) : - of X ⟶ of Y := - ConcreteCategory.ofHom (C := FinBddDistLat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : FinBddDistLat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category FinBddDistLat (BoundedLatticeHom · ·) + (fun (X : FinBddDistLat) ↦ BoundedLatticeHom.id X) + BoundedLatticeHom.comp + with_of_hom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [Fintype X] + [DistribLattice Y] [BoundedOrder Y] [Fintype Y] + hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -106,17 +74,10 @@ lemma forget_map {X Y : FinBddDistLat} (f : X ⟶ Y) : lemma ext {X Y : FinBddDistLat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := ConcreteCategory.hom_ext _ _ w -@[simp] -lemma hom_id {X : FinBddDistLat} : (𝟙 X : X ⟶ X).hom = BoundedLatticeHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : FinBddDistLat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : FinBddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : FinBddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -125,14 +86,6 @@ lemma comp_apply {X Y Z : FinBddDistLat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : FinBddDistLat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [Fintype X] [DistribLattice Y] - [BoundedOrder Y] [Fintype Y] (f : BoundedLatticeHom X Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {X Y : FinBddDistLat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [DistribLattice X] [BoundedOrder X] [Fintype X] : ofHom (BoundedLatticeHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/Frm.lean b/Mathlib/Order/Category/Frm.lean index 1d87b29e749074..a5c369b0e3ecdf 100644 --- a/Mathlib/Order/Category/Frm.lean +++ b/Mathlib/Order/Category/Frm.lean @@ -45,41 +45,9 @@ instance : CoeSort Frm (Type _) := attribute [coe] Frm.carrier -set_option backward.privateInPublic true in -/-- The type of morphisms in `Frm R`. -/ -@[ext] -structure Hom (X Y : Frm.{u}) where - private mk :: - /-- The underlying `FrameHom`. -/ - hom' : FrameHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category Frm.{u} where - Hom X Y := Hom X Y - id X := ⟨FrameHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory Frm (FrameHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `Frm` back into a `FrameHom`. -/ -abbrev Hom.hom {X Y : Frm.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := Frm) f - -/-- Typecheck a `FrameHom` as a morphism in `Frm`. -/ -abbrev ofHom {X Y : Type u} [Frame X] [Frame Y] (f : FrameHom X Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := Frm) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : Frm.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category Frm (FrameHom · ·) (fun (X : Frm) ↦ FrameHom.id X) FrameHom.comp + with_of_hom {X Y : Type u} [Frame X] [Frame Y] + hom_type (FrameHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -102,17 +70,10 @@ lemma ext {X Y : Frm} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [Frame X] : (Frm.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : Frm} : (𝟙 X : X ⟶ X).hom = FrameHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : Frm) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : Frm} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : Frm} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -121,13 +82,6 @@ lemma comp_apply {X Y Z : Frm} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : Frm} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [Frame X] [Frame Y] (f : FrameHom X Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {X Y : Frm} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [Frame X] : ofHom (FrameHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/HeytAlg.lean b/Mathlib/Order/Category/HeytAlg.lean index 1d19ad5e2ede62..da71f219b554d6 100644 --- a/Mathlib/Order/Category/HeytAlg.lean +++ b/Mathlib/Order/Category/HeytAlg.lean @@ -41,42 +41,10 @@ attribute [coe] HeytAlg.carrier /-- Construct a bundled `HeytAlg` from the underlying type and typeclass. -/ abbrev of (X : Type*) [HeytingAlgebra X] : HeytAlg := ⟨X⟩ -set_option backward.privateInPublic true in -/-- The type of morphisms in `HeytAlg R`. -/ -@[ext] -structure Hom (X Y : HeytAlg.{u}) where - private mk :: - /-- The underlying `HeytingHom`. -/ - hom' : HeytingHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category HeytAlg.{u} where - Hom X Y := Hom X Y - id X := ⟨HeytingHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory HeytAlg (HeytingHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `HeytAlg` back into a `HeytingHom`. -/ -abbrev Hom.hom {X Y : HeytAlg.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := HeytAlg) f - -/-- Typecheck a `HeytingHom` as a morphism in `HeytAlg`. -/ -abbrev ofHom {X Y : Type u} [HeytingAlgebra X] [HeytingAlgebra Y] (f : HeytingHom X Y) : - of X ⟶ of Y := - ConcreteCategory.ofHom (C := HeytAlg) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : HeytAlg.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category HeytAlg (HeytingHom · ·) (fun (X : HeytAlg) ↦ HeytingHom.id X) + HeytingHom.comp + with_of_hom {X Y : Type u} [HeytingAlgebra X] [HeytingAlgebra Y] + hom_type (HeytingHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -99,17 +67,10 @@ lemma ext {X Y : HeytAlg} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [HeytingAlgebra X] : (HeytAlg.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : HeytAlg} : (𝟙 X : X ⟶ X).hom = HeytingHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : HeytAlg) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : HeytAlg} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : HeytAlg} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -118,15 +79,6 @@ lemma comp_apply {X Y Z : HeytAlg} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : HeytAlg} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [HeytingAlgebra X] [HeytingAlgebra Y] (f : HeytingHom X Y) : - (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : HeytAlg} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [HeytingAlgebra X] : ofHom (HeytingHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/Lat.lean b/Mathlib/Order/Category/Lat.lean index 6e4dc11410bbe7..d761abe2c48261 100644 --- a/Mathlib/Order/Category/Lat.lean +++ b/Mathlib/Order/Category/Lat.lean @@ -48,41 +48,9 @@ attribute [coe] Lat.carrier /-- Construct a bundled `Lat` from the underlying type and typeclass. -/ abbrev of (X : Type*) [Lattice X] : Lat := ⟨X⟩ -set_option backward.privateInPublic true in -/-- The type of morphisms in `Lat R`. -/ -@[ext] -structure Hom (X Y : Lat.{u}) where - private mk :: - /-- The underlying `LatticeHom`. -/ - hom' : LatticeHom X Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category Lat.{u} where - Hom X Y := Hom X Y - id X := ⟨LatticeHom.id X⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory Lat (LatticeHom · ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `Lat` back into a `LatticeHom`. -/ -abbrev Hom.hom {X Y : Lat.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := Lat) f - -/-- Typecheck a `LatticeHom` as a morphism in `Lat`. -/ -abbrev ofHom {X Y : Type u} [Lattice X] [Lattice Y] (f : LatticeHom X Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := Lat) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : Lat.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category Lat (LatticeHom · ·) (fun (X : Lat) ↦ LatticeHom.id X) LatticeHom.comp + with_of_hom {X Y : Type u} [Lattice X] [Lattice Y] + hom_type (LatticeHom X Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -105,17 +73,10 @@ lemma ext {X Y : Lat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [Lattice X] : (Lat.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : Lat} : (𝟙 X : X ⟶ X).hom = LatticeHom.id _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : Lat) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : Lat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : Lat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -124,14 +85,6 @@ lemma comp_apply {X Y Z : Lat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : Lat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [Lattice X] [Lattice Y] (f : LatticeHom X Y) : (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : Lat} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [Lattice X] : ofHom (LatticeHom.id _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/LinOrd.lean b/Mathlib/Order/Category/LinOrd.lean index 265092eefad930..0119c6498a3c39 100644 --- a/Mathlib/Order/Category/LinOrd.lean +++ b/Mathlib/Order/Category/LinOrd.lean @@ -22,41 +22,9 @@ universe u namespace LinOrd -set_option backward.privateInPublic true in -/-- The type of morphisms in `LinOrd R`. -/ -@[ext] -structure Hom (X Y : LinOrd.{u}) where - private mk :: - /-- The underlying `OrderHom`. -/ - hom' : X →o Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category LinOrd.{u} where - Hom X Y := Hom X Y - id _ := ⟨OrderHom.id⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory LinOrd (· →o ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `LinOrd` back into a `OrderHom`. -/ -abbrev Hom.hom {X Y : LinOrd.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := LinOrd) f - -/-- Typecheck a `OrderHom` as a morphism in `LinOrd`. -/ -abbrev ofHom {X Y : Type u} [LinearOrder X] [LinearOrder Y] (f : X →o Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := LinOrd) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : LinOrd.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category LinOrd (· →o ·) (fun (_ : LinOrd) ↦ OrderHom.id) OrderHom.comp + with_of_hom {X Y : Type u} [LinearOrder X] [LinearOrder Y] + hom_type (X →o Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -79,17 +47,10 @@ lemma ext {X Y : LinOrd} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [LinearOrder X] : (LinOrd.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : LinOrd} : (𝟙 X : X ⟶ X).hom = OrderHom.id := rfl - /- Provided for rewriting. -/ lemma id_apply (X : LinOrd) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : LinOrd} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : LinOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -98,14 +59,6 @@ lemma comp_apply {X Y Z : LinOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : LinOrd} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [LinearOrder X] [LinearOrder Y] (f : X →o Y) : (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : LinOrd} (f : X ⟶ Y) : - ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [LinearOrder X] : ofHom OrderHom.id = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/PartOrd.lean b/Mathlib/Order/Category/PartOrd.lean index 986b64fcea5f52..d1731fd492b027 100644 --- a/Mathlib/Order/Category/PartOrd.lean +++ b/Mathlib/Order/Category/PartOrd.lean @@ -40,41 +40,9 @@ instance : CoeSort PartOrd (Type _) := attribute [coe] PartOrd.carrier -set_option backward.privateInPublic true in -/-- The type of morphisms in `PartOrd R`. -/ -@[ext] -structure Hom (X Y : PartOrd.{u}) where - private mk :: - /-- The underlying `OrderHom`. -/ - hom' : X →o Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category PartOrd.{u} where - Hom X Y := Hom X Y - id _ := ⟨OrderHom.id⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory PartOrd (· →o ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `PartOrd` back into a `OrderHom`. -/ -abbrev Hom.hom {X Y : PartOrd.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := PartOrd) f - -/-- Typecheck a `OrderHom` as a morphism in `PartOrd`. -/ -abbrev ofHom {X Y : Type u} [PartialOrder X] [PartialOrder Y] (f : X →o Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := PartOrd) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : PartOrd.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category PartOrd (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp + with_of_hom {X Y : Type u} [PartialOrder X] [PartialOrder Y] + hom_type (X →o Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -95,17 +63,10 @@ lemma ext {X Y : PartOrd} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [PartialOrder X] : (PartOrd.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : PartOrd} : (𝟙 X : X ⟶ X).hom = OrderHom.id := rfl - /- Provided for rewriting. -/ lemma id_apply (X : PartOrd) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : PartOrd} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : PartOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -114,13 +75,6 @@ lemma comp_apply {X Y Z : PartOrd} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : PartOrd} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [PartialOrder X] [PartialOrder Y] (f : X →o Y) : (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : PartOrd} (f : X ⟶ Y) : ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [PartialOrder X] : ofHom OrderHom.id = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/PartOrdEmb.lean b/Mathlib/Order/Category/PartOrdEmb.lean index 7441fbffd968a9..f49d1406509704 100644 --- a/Mathlib/Order/Category/PartOrdEmb.lean +++ b/Mathlib/Order/Category/PartOrdEmb.lean @@ -43,41 +43,9 @@ instance : CoeSort PartOrdEmb (Type _) := attribute [coe] PartOrdEmb.carrier -set_option backward.privateInPublic true in -/-- The type of morphisms in `PartOrdEmb R`. -/ -@[ext] -structure Hom (X Y : PartOrdEmb.{u}) where - private mk :: - /-- The underlying `OrderEmbedding`. -/ - hom' : X ↪o Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category PartOrdEmb.{u} where - Hom X Y := Hom X Y - id _ := ⟨RelEmbedding.refl _⟩ - comp f g := ⟨f.hom'.trans g.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory PartOrdEmb (· ↪o ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `PartOrdEmb` back into a `OrderEmbedding`. -/ -abbrev Hom.hom {X Y : PartOrdEmb.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := PartOrdEmb) f - -/-- Typecheck a `OrderEmbedding` as a morphism in `PartOrdEmb`. -/ -abbrev ofHom {X Y : Type u} [PartialOrder X] [PartialOrder Y] (f : X ↪o Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := PartOrdEmb) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : PartOrdEmb.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category PartOrdEmb (· ↪o ·) (fun _ ↦ RelEmbedding.refl _) (fun g f ↦ f.trans g) + with_of_hom {X Y : Type u} [PartialOrder X] [PartialOrder Y] + hom_type (X ↪o Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -100,16 +68,10 @@ lemma ext {X Y : PartOrdEmb} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [PartialOrder X] : (PartOrdEmb.of X : Type u) = X := rfl -lemma hom_id {X : PartOrdEmb} : (𝟙 X : X ⟶ X).hom = RelEmbedding.refl _ := rfl - /- Provided for rewriting. -/ lemma id_apply (X : PartOrdEmb) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : PartOrdEmb} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = f.hom.trans g.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : PartOrdEmb} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -125,14 +87,6 @@ lemma Hom.le_iff_le {X Y : PartOrdEmb.{u}} (f : X ⟶ Y) (x₁ x₂ : X) : lemma hom_ext {X Y : PartOrdEmb} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [PartialOrder X] [PartialOrder Y] (f : X ↪o Y) : - (ofHom f).hom = f := - rfl - -@[simp] -lemma ofHom_hom {X Y : PartOrdEmb} (f : X ⟶ Y) : ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [PartialOrder X] : ofHom (RelEmbedding.refl _) = 𝟙 (of X) := rfl diff --git a/Mathlib/Order/Category/Preord.lean b/Mathlib/Order/Category/Preord.lean index 760af02549d139..35d3f228148d28 100644 --- a/Mathlib/Order/Category/Preord.lean +++ b/Mathlib/Order/Category/Preord.lean @@ -10,6 +10,7 @@ public import Mathlib.CategoryTheory.Category.Preorder public import Mathlib.CategoryTheory.ConcreteCategory.Forget public import Mathlib.Order.Hom.Basic public import Mathlib.Order.CompleteBooleanAlgebra +public import Mathlib.Tactic.CategoryTheory.MkConcreteCategory /-! # Category of preorders @@ -43,41 +44,9 @@ instance : CoeSort Preord (Type u) := attribute [coe] Preord.carrier -set_option backward.privateInPublic true in -/-- The type of morphisms in `Preord R`. -/ -@[ext] -structure Hom (X Y : Preord.{u}) where - private mk :: - /-- The underlying `OrderHom`. -/ - hom' : X →o Y - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category Preord.{u} where - Hom X Y := Hom X Y - id _ := ⟨OrderHom.id⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory Preord (· →o ·) where - hom := Hom.hom' - ofHom := Hom.mk - -/-- Turn a morphism in `Preord` back into a `OrderHom`. -/ -abbrev Hom.hom {X Y : Preord.{u}} (f : Hom X Y) := - ConcreteCategory.hom (C := Preord) f - -/-- Typecheck a `OrderHom` as a morphism in `Preord`. -/ -abbrev ofHom {X Y : Type u} [Preorder X] [Preorder Y] (f : X →o Y) : of X ⟶ of Y := - ConcreteCategory.ofHom (C := Preord) f - -variable {R} in -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (X Y : Preord.{u}) (f : Hom X Y) := - f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category Preord (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp + with_of_hom {X Y : Type u} [Preorder X] [Preorder Y] + hom_type (X →o Y) from (of X) to (of Y) /-! The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. @@ -98,17 +67,10 @@ lemma ext {X Y : Preord} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := -- This is not `simp` to avoid rewriting in types of terms. theorem coe_of (X : Type u) [Preorder X] : (Preord.of X : Type u) = X := rfl -@[simp] -lemma hom_id {X : Preord} : (𝟙 X : X ⟶ X).hom = OrderHom.id := rfl - /- Provided for rewriting. -/ lemma id_apply (X : Preord) (x : X) : (𝟙 X : X ⟶ X) x = x := by simp -@[simp] -lemma hom_comp {X Y Z : Preord} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ lemma comp_apply {X Y Z : Preord} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := by simp @@ -117,12 +79,6 @@ lemma comp_apply {X Y Z : Preord} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : lemma hom_ext {X Y : Preord} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g := Hom.ext hf -@[simp] -lemma hom_ofHom {X Y : Type u} [Preorder X] [Preorder Y] (f : X →o Y) : (ofHom f).hom = f := rfl - -@[simp] -lemma ofHom_hom {X Y : Preord} (f : X ⟶ Y) : ofHom (Hom.hom f) = f := rfl - @[simp] lemma ofHom_id {X : Type u} [Preorder X] : ofHom OrderHom.id = 𝟙 (of X) := rfl diff --git a/Mathlib/RepresentationTheory/Rep/Basic.lean b/Mathlib/RepresentationTheory/Rep/Basic.lean index d27c5342cd6996..a65826ceb7f560 100644 --- a/Mathlib/RepresentationTheory/Rep/Basic.lean +++ b/Mathlib/RepresentationTheory/Rep/Basic.lean @@ -67,52 +67,19 @@ lemma of_V : (of ρ).V = X := by with_reducible rfl variable (X ρ) in lemma of_ρ : (of ρ).ρ = ρ := by with_reducible rfl -set_option backward.privateInPublic true in -/-- The type of morphisms in `Rep.{w} k G`. -/ -@[ext] -structure Hom where - private mk :: - /-- The underlying `G`-equivariant linear map. -/ - hom' : A.ρ.IntertwiningMap B.ρ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : Category (Rep.{w} k G) where - Hom A B := Hom A B - id A := ⟨.id A.ρ⟩ - comp f g := ⟨g.hom'.comp f.hom'⟩ - -set_option backward.privateInPublic true in -set_option backward.privateInPublic.warn false in -instance : ConcreteCategory (Rep.{w} k G) (fun A B ↦ A.ρ.IntertwiningMap B.ρ) where - hom := Hom.hom' - ofHom := Hom.mk - -variable {A B} in -/-- Turn a morphism in `Rep` back into an `IntertwiningMap`. -/ -abbrev Hom.hom (f : Hom A B) := ConcreteCategory.hom (C := Rep k G) f - -variable {A B} in -/-- Typecheck an `IntertwiningMap` as a morphism in `Rep`. -/ -abbrev ofHom (f : ρ.IntertwiningMap σ) : of ρ ⟶ of σ := - ConcreteCategory.ofHom (C := Rep.{w} k G) f - -/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/ -def Hom.Simps.hom (f : Hom A B) := f.hom - -initialize_simps_projections Hom (hom' → hom) +mk_concrete_category (Rep.{w} k G) (fun A B ↦ A.ρ.IntertwiningMap B.ρ) + (fun A ↦ Representation.IntertwiningMap.id A.ρ) (fun g f ↦ g.comp f) + with_of_hom {X Y : Type w} [AddCommGroup X] [AddCommGroup Y] [Module k X] [Module k Y] + {ρ : Representation k G X} {σ : Representation k G Y} + hom_type (ρ.IntertwiningMap σ) from (of ρ) to (of σ) /- The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] lemma hom_id : (𝟙 A : A ⟶ A).hom = .id A.ρ := rfl - /- Provided for rewriting. -/ lemma id_apply (a : A) : (𝟙 A : A ⟶ A) a = a := by simp [Representation.IntertwiningMap.id] -@[simp] lemma hom_comp (f : A ⟶ B) (g : B ⟶ C) : (f ≫ g).hom = g.hom.comp f.hom := rfl - /- Provided for rewriting. -/ variable {A B C} in lemma comp_apply (f : A ⟶ B) (g : B ⟶ C) (a : A) : (f ≫ g) a = g (f a) := by simp @@ -126,9 +93,6 @@ lemma hom_comm_apply (f : A ⟶ B) (g : G) (a : A) : f.hom (A.ρ g a) = B.ρ g ( variable {Z : Type w} [AddCommGroup Z] [Module k Z] {τ : Representation k G Z} -@[simp] lemma hom_ofHom (f : ρ.IntertwiningMap σ) : (ofHom f).hom = f := rfl -@[simp] lemma ofHom_hom (f : A ⟶ B) : ofHom f.hom = f := rfl - @[simp] lemma ofHom_id : ofHom (.id σ) = 𝟙 (of σ) := rfl @[simp] From 73cef0f62d79e92529685392e907c836b9a3dc82 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 15:19:25 -0600 Subject: [PATCH 20/34] dsimp% hom_comp lemma --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 63bcb1ecf219dc..7a67732b782c50 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -368,13 +368,13 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| @[to_additive (attr := simp), simp] lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($compTerm) g.hom f.hom) := + (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := rfl) else elabCommand <| ← set_option hygiene false in `(command| @[simp] lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($compTerm) g.hom f.hom) := + (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := rfl) if useToAdditive then From 45bb7f37e250465106aa439183f5fa5672ec9f78 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 15:45:36 -0600 Subject: [PATCH 21/34] generate correct hom_ofHom lemma --- .../CategoryTheory/MkConcreteCategory.lean | 37 +++++++++++++------ .../CategoryTheory/MkConcreteCategory.lean | 13 ++++--- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 7a67732b782c50..cddd0f3673379a 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -377,18 +377,31 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := rfl) - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) + match customOfHom? with + | some (binders, homTy, _, _) => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := + rfl) + | none => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 6ed7cc0db73cd4..097b73fbca5491 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -208,8 +208,10 @@ info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestC #guard_msgs in #check hom_comp -/-- info: ModuleTestCat.hom_ofHom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : ↑X →ₗ[R] ↑Y) : - Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- +info: ModuleTestCat.hom_ofHom.{v, u} {R : Type u} [Ring R] {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] + [Module R Y] (f : X →ₗ[R] Y) : Hom.hom (ofHom f) = f +-/ #guard_msgs in #check hom_ofHom @@ -326,8 +328,9 @@ namespace MultiplicativeTestCat #guard_msgs in #check hom_comp -/-- info: MultiplicativeTestCat.hom_ofHom.{u_1} {X Y : MultiplicativeTestCat} (f : ↑X →* ↑Y) : - Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- +info: MultiplicativeTestCat.hom_ofHom.{u} {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : Hom.hom (ofHom f) = f +-/ #guard_msgs in #check hom_ofHom @@ -388,7 +391,7 @@ namespace AdditiveTestCat #guard_msgs in #check hom_comp -/-- info: AdditiveTestCat.hom_ofHom.{u_1} {X Y : AdditiveTestCat} (f : ↑X →+ ↑Y) : Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- info: AdditiveTestCat.hom_ofHom.{u} {X Y : Type u} [AddMonoid X] [AddMonoid Y] (f : X →+ Y) : Hom.hom (ofHom f) = f -/ #guard_msgs in #check hom_ofHom From e674b7668a357ba5c23f2dfcbdcac33fc3406bc3 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 29 Apr 2026 22:44:20 -0600 Subject: [PATCH 22/34] fixes --- Mathlib/AlgebraicGeometry/IdealSheaf/Subscheme.lean | 5 +++-- Mathlib/Condensed/Light/Sequence.lean | 12 ++++++------ .../Homological/GroupHomology/Functoriality.lean | 8 ++++---- Mathlib/Topology/Sheaves/LocalPredicate.lean | 4 ++-- 4 files changed, 15 insertions(+), 14 deletions(-) diff --git a/Mathlib/AlgebraicGeometry/IdealSheaf/Subscheme.lean b/Mathlib/AlgebraicGeometry/IdealSheaf/Subscheme.lean index 6aa80fe3e4d643..aefbad7d45bf26 100644 --- a/Mathlib/AlgebraicGeometry/IdealSheaf/Subscheme.lean +++ b/Mathlib/AlgebraicGeometry/IdealSheaf/Subscheme.lean @@ -146,7 +146,8 @@ lemma glueDataObjMap_glueDataObjι {U V : X.affineOpens} (h : U ≤ V) : Ideal.quotientMap_comp_mk, CommRingCat.ofHom_comp, Spec.map_comp_assoc, glueDataObjι, Category.assoc] congr 1 - rw [Iso.eq_inv_comp, IsAffineOpen.isoSpec_hom, CommRingCat.ofHom_hom] + rw [Iso.eq_inv_comp, IsAffineOpen.isoSpec_hom] + dsimp erw [Scheme.Opens.toSpecΓ_SpecMap_presheaf_map_assoc U.1 V.1 h] rw [← IsAffineOpen.isoSpec_hom V.2, Iso.hom_inv_id, Category.comp_id] @@ -741,7 +742,7 @@ lemma Hom.toImage_app : ← IsIso.eq_comp_inv, ← Functor.map_inv] simp only [Hom.comp_base, Opens.map_comp_obj, Category.assoc, Iso.inv_hom_id_assoc, eqToHom_op, inv_eqToHom] - rw [← reassoc_of% CommRingCat.ofHom_comp, Ideal.Quotient.lift_comp_mk, CommRingCat.ofHom_hom, + rw [← reassoc_of% CommRingCat.ofHom_comp, Ideal.Quotient.lift_comp_mk, eqToHom_refl, CategoryTheory.Functor.map_id] exact (Category.comp_id _).symm diff --git a/Mathlib/Condensed/Light/Sequence.lean b/Mathlib/Condensed/Light/Sequence.lean index 541eb9ab95c7af..55e559602dd8c3 100644 --- a/Mathlib/Condensed/Light/Sequence.lean +++ b/Mathlib/Condensed/Light/Sequence.lean @@ -32,7 +32,7 @@ def LightProfinite.fibre : LightProfinite := isCompact_iff_compactSpace.mp (IsClosed.preimage (by fun_prop) isClosed_singleton).isCompact of (f ⁻¹' {y}) -def LightProfinite.fibreIncl : fibre y f ⟶ X := ⟨⟨{ toFun := Subtype.val }⟩⟩ +def LightProfinite.fibreIncl : fibre y f ⟶ X := ⟨TopCat.ofHom { toFun := Subtype.val }⟩ end @@ -190,9 +190,9 @@ are equal. This can be checked by precomposing with an epimorphism, which is given by this morphism. -/ def cover {S T : LightProfinite} (π : T ⟶ S ⊗ ℕ∪{∞}) : (of _ (T ⊕ (pullback (LightProfinite.fibreIncl ∞ (π ≫ snd S ℕ∪{∞}) ≫ π) - (LightProfinite.fibreIncl ∞ (π ≫ snd S ℕ∪{∞}) ≫ π)))) ⟶ pullback π π := ⟨⟨{ + (LightProfinite.fibreIncl ∞ (π ≫ snd S ℕ∪{∞}) ≫ π)))) ⟶ pullback π π := ⟨TopCat.ofHom { toFun := coverToFun _ _ - continuous_toFun := by dsimp [coverToFun]; fun_prop }⟩⟩ + continuous_toFun := by dsimp [coverToFun]; fun_prop }⟩ open Limits in set_option backward.isDefEq.respectTransparency false in @@ -262,7 +262,7 @@ lemma aux {S T : LightProfinite} (π : T ⟶ S ⊗ ℕ∪{∞}) [Epi π] : -- `fibres`. have := S'_compactSpace π (by fun_prop) let S'π (n : ℕ∪{∞}) : LightProfinite.of (S' π) ⟶ LightProfinite.fibre n (π ≫ snd _ _) := - ⟨⟨{ toFun x := x.val n, continuous_toFun := by refine (continuous_apply _).comp ?_; fun_prop }⟩⟩ + ⟨TopCat.ofHom ⟨fun x ↦ x.val n, by refine (continuous_apply _).comp ?_; fun_prop⟩⟩ let y' : LightProfinite.of (S' π) ⟶ S := ConcreteCategory.ofHom ⟨y π, y_continuous π⟩ let π' := pullback.snd π (y' ▷ ℕ∪{∞}) let σ' : ℕ∪{∞} → LightProfinite.of (S' π) → pullback π (y' ▷ ℕ∪{∞}) := fun n ↦ @@ -276,8 +276,8 @@ lemma aux {S T : LightProfinite} (π : T ⟶ S ⊗ ℕ∪{∞}) [Epi π] : have : CompactSpace (fibres π' σ') := isCompact_iff_compactSpace.mp (fibres_closed π' (by fun_prop) σ' (by fun_prop) hσ').isCompact refine ⟨LightProfinite.of (S' π), LightProfinite.of (fibres π' σ'), y', - ⟨⟨Subtype.val, by fun_prop⟩⟩ ≫ π', - ⟨⟨Subtype.val, by fun_prop⟩⟩ ≫ pullback.fst _ _, ?_, ?_, ?_, ?_, ?_⟩ + ⟨TopCat.ofHom ⟨Subtype.val, by fun_prop⟩⟩ ≫ π', + ⟨TopCat.ofHom ⟨Subtype.val, by fun_prop⟩⟩ ≫ pullback.fst _ _, ?_, ?_, ?_, ?_, ?_⟩ · rw [LightProfinite.epi_iff_surjective] refine fibres_surjective _ ?_ _ hσ hσ' rw [← LightProfinite.epi_iff_surjective] diff --git a/Mathlib/RepresentationTheory/Homological/GroupHomology/Functoriality.lean b/Mathlib/RepresentationTheory/Homological/GroupHomology/Functoriality.lean index 17625b0ba711bc..70893cdf09d384 100644 --- a/Mathlib/RepresentationTheory/Homological/GroupHomology/Functoriality.lean +++ b/Mathlib/RepresentationTheory/Homological/GroupHomology/Functoriality.lean @@ -415,7 +415,7 @@ instance mapCycles₁_quotientGroupMk'_epi : choose! s hs using QuotientGroup.mk_surjective (s := S) have hs₁ : QuotientGroup.mk ∘ s = id := funext hs refine ⟨⟨mapDomain s x, ?_⟩, Subtype.ext <| by - simp [mapCycles₁_hom, ← mapDomain_comp, hs₁, res, Rep.hom_id (of _)]⟩ + simp [mapCycles₁_hom, ← mapDomain_comp, hs₁, res, Rep.hom_id (X := of _)]⟩ simpa [mem_cycles₁_iff, ← (mem_cycles₁_iff _).1 hx, sum_mapDomain_index_inj (f := s) (fun x y h => by rw [← hs x, ← hs y, h])] using Finsupp.sum_congr fun a b => QuotientGroup.induction_on a fun a => by @@ -472,14 +472,14 @@ theorem H1CoresCoinfOfTrivial_exact : (d₂₁ (A.ofQuotient S)).hom y := by have := congr($((mapShortComplexH1 (QuotientGroup.mk' S) (resOfQuotientIso A S).inv).comm₁₂.symm) z) - simp_all [shortComplexH1, z, ← mapDomain_comp, Prod.map_comp_map, Rep.hom_id (res _ _)] + simp_all [shortComplexH1, z, ← mapDomain_comp, Prod.map_comp_map, Rep.hom_id (X := res _ _)] let v := x - (d₂₁ _).hom z /- We have `C₁(s ∘ π)(v) = ∑ v(g)·s(π(g)) = 0`, since `C₁(π)(v) = dC₁(π)(z) - C₁(π)(dz) = 0` by previous assumptions. -/ have hv : mapDomain (s ∘ QuotientGroup.mk) v = 0 := by rw [mapDomain_comp] simp only [QuotientGroup.coe_mk', lmapDomain_apply, mapDomain_sub, v] at hz ⊢ - simp [hz, hy, coe_mapCycles₁ (QuotientGroup.mk' S), Rep.hom_id (of _)] + simp [hz, hy, coe_mapCycles₁ (QuotientGroup.mk' S), Rep.hom_id (X := of _)] let e : G → G × G := fun (g : G) => (s (g : G ⧸ S), (s (g : G ⧸ S))⁻¹ * g) have he : e.Injective := fun x y hxy => by obtain ⟨(h₁ : s _ = s _), (h₂ : _ * _ = _ * _)⟩ := Prod.ext_iff.1 hxy @@ -591,7 +591,7 @@ and `Y - ∑ aᵢ·sᵢ` is a cycle. -/ /- Moreover, the image of `Y - ∑ aᵢ·sᵢ` in `Z₁(G ⧸ S, A_S)` is `x - ∑ aᵢ·1`, and hence differs from `x` by a boundary, since `aᵢ·1 = d(aᵢ·(1, 1))`. -/ refine (H1π_eq_iff _ _).2 ?_ - simpa [← hy, mapCycles₁_hom, map_sub, Rep.hom_id (res _ _), ← mapDomain_comp, + simpa [← hy, mapCycles₁_hom, map_sub, Rep.hom_id (X := res _ _), ← mapDomain_comp, ← mapDomain_mapRange, hY, Function.comp_def, (QuotientGroup.eq_one_iff <| Subtype.val _).2 (Subtype.prop _)] using Submodule.finsuppSum_mem _ _ _ _ fun _ _ ↦ single_one_mem_boundaries₁ _ diff --git a/Mathlib/Topology/Sheaves/LocalPredicate.lean b/Mathlib/Topology/Sheaves/LocalPredicate.lean index dbd6efe16d6c83..7897bbae9e2ef6 100644 --- a/Mathlib/Topology/Sheaves/LocalPredicate.lean +++ b/Mathlib/Topology/Sheaves/LocalPredicate.lean @@ -361,8 +361,8 @@ the presheaf of continuous functions. def subpresheafContinuousPrelocalIsoPresheafToTop {X : TopCat.{u}} (T : TopCat.{u}) : subpresheafToTypes (continuousPrelocal X T) ≅ presheafToTop X T := NatIso.ofComponents fun X ↦ - { hom := TypeCat.ofHom <| by rintro ⟨f, c⟩; exact ofHom ⟨f, c⟩ - inv := TypeCat.ofHom <| by rintro ⟨f, c⟩; exact ⟨f, c⟩ } + { hom := TypeCat.ofHom <| fun f ↦ ofHom ⟨f.1, f.2⟩ + inv := TypeCat.ofHom <| fun f ↦ ⟨f.1, f.1.2⟩ } /-- The sheaf of continuous functions on `X` with values in a space `T`. -/ From b81dcd8351932c47ff90208d50294a72232883f8 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Thu, 30 Apr 2026 08:33:55 -0600 Subject: [PATCH 23/34] fix the build --- Mathlib/AlgebraicGeometry/AffineSpace.lean | 7 +++---- Mathlib/AlgebraicGeometry/Morphisms/Smooth.lean | 5 +++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Mathlib/AlgebraicGeometry/AffineSpace.lean b/Mathlib/AlgebraicGeometry/AffineSpace.lean index 7699e70feee892..f27e5c4b0ad991 100644 --- a/Mathlib/AlgebraicGeometry/AffineSpace.lean +++ b/Mathlib/AlgebraicGeometry/AffineSpace.lean @@ -176,9 +176,8 @@ def isoOfIsAffine [IsAffine S] : hom_inv_id := by ext1 · simp only [Category.assoc, homOfVector_over, Category.id_comp] - rw [← Spec.map_comp_assoc, ← CommRingCat.ofHom_comp, eval₂Hom_comp_C, - CommRingCat.ofHom_hom, ← Scheme.toSpecΓ_naturality_assoc] - simp [Scheme.isoSpec] + rw [← Spec.map_comp_assoc, ← CommRingCat.ofHom_comp, eval₂Hom_comp_C] + simp [← Scheme.toSpecΓ_naturality_assoc] · simp inv_hom_id := by apply ext_of_isAffine @@ -299,7 +298,7 @@ lemma map_SpecMap {R S : CommRingCat.{max u v}} (φ : R ⟶ S) : ext1 · simp only [map_over, Category.assoc, SpecIso_inv_over, SpecIso_inv_over_assoc, ← Spec.map_comp, ← CommRingCat.ofHom_comp] - rw [map_comp_C, CommRingCat.ofHom_comp, CommRingCat.ofHom_hom] + simp · simp only [TopologicalSpace.Opens.map_top, Scheme.Hom.comp_app, CommRingCat.comp_apply] conv_lhs => enter [2]; tactic => exact map_appTop_coord _ _ conv_rhs => enter [2]; tactic => exact SpecIso_inv_appTop_coord _ _ diff --git a/Mathlib/AlgebraicGeometry/Morphisms/Smooth.lean b/Mathlib/AlgebraicGeometry/Morphisms/Smooth.lean index 0ddb9562d5e0d0..b7254d18c7c1db 100644 --- a/Mathlib/AlgebraicGeometry/Morphisms/Smooth.lean +++ b/Mathlib/AlgebraicGeometry/Morphisms/Smooth.lean @@ -216,8 +216,9 @@ instance smoothOfRelativeDimension_comp {Z : Scheme.{u}} (g : Y ⟶ Z) have heq : (f ≫ g).appLE U₂ (X.basicOpen s) e = g.appLE U₂ V₂ e₂ ≫ CommRingCat.ofHom (algebraMap Γ(Y, V₂) Γ(Y, Y.basicOpen r)) ≫ f.appLE (Y.basicOpen r) (X.basicOpen s) e₁ := by - rw [RingHom.algebraMap_toAlgebra, CommRingCat.ofHom_hom, - g.appLE_map_assoc, Scheme.Hom.appLE_comp_appLE] + rw [RingHom.algebraMap_toAlgebra] + dsimp + rw [g.appLE_map_assoc, Scheme.Hom.appLE_comp_appLE] refine ⟨U₂, hU₂, X.basicOpen s, hV₁'.basicOpen s, hx₁, e, heq ▸ ?_⟩ apply IsStandardSmoothOfRelativeDimension.comp ?_ hf₂ haveI : IsLocalization.Away r Γ(Y, Y.basicOpen r) := hV₂.isLocalization_basicOpen r From d50f6e3f1479cc4b6ba2b903c0aca2820cbedc5b Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Thu, 30 Apr 2026 23:18:10 -0600 Subject: [PATCH 24/34] lint --- Mathlib/Algebra/Category/ModuleCat/Semi.lean | 2 +- Mathlib/Order/Category/PartOrdEmb.lean | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/Mathlib/Algebra/Category/ModuleCat/Semi.lean b/Mathlib/Algebra/Category/ModuleCat/Semi.lean index a58e2aef09d5b2..db19d2f36c90ba 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Semi.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Semi.lean @@ -259,7 +259,7 @@ instance : Zero (M ⟶ N) where instance : SMul ℕ (M ⟶ N) where smul n f := ofHom (n • f.hom) -@[simp] lemma hom_nsmul (n : ℕ) (f : M ⟶ N) : (n • f).hom = n • f.hom := by +lemma hom_nsmul (n : ℕ) (f : M ⟶ N) : (n • f).hom = n • f.hom := by change (ofHom (n • f.hom)).hom = n • f.hom simp diff --git a/Mathlib/Order/Category/PartOrdEmb.lean b/Mathlib/Order/Category/PartOrdEmb.lean index f49d1406509704..75bb377316548c 100644 --- a/Mathlib/Order/Category/PartOrdEmb.lean +++ b/Mathlib/Order/Category/PartOrdEmb.lean @@ -51,7 +51,6 @@ mk_concrete_category PartOrdEmb (· ↪o ·) (fun _ ↦ RelEmbedding.refl _) (fu The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`. -/ -@[simp] lemma coe_id {X : PartOrdEmb} : (𝟙 X : X → X) = id := rfl @[simp] From 3237992f97315839f1da8069bd3e9d14f77df67a Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Thu, 30 Apr 2026 23:20:57 -0600 Subject: [PATCH 25/34] chore: sync concrete category tactic files --- .../CategoryTheory/MkConcreteCategory.lean | 45 ++++++++++++------- .../CategoryTheory/MkConcreteCategory.lean | 21 +++++---- 2 files changed, 41 insertions(+), 25 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index b4199b20bfe130..cddd0f3673379a 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -294,12 +294,12 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| /-- Turn a categorical morphism back into its underlying bundled morphism. -/ @[to_additive] - abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := CategoryTheory.ConcreteCategory.hom (C := $cat) f) else elabCommand <| ← set_option hygiene false in `(command| /-- Turn a categorical morphism back into its underlying bundled morphism. -/ - abbrev Hom.hom {X Y : $cat} (f : Hom (X := X) (Y := Y)) := + abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := CategoryTheory.ConcreteCategory.hom (C := $cat) f) match customOfHom? with @@ -368,27 +368,40 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| @[to_additive (attr := simp), simp] lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($compTerm) g.hom f.hom) := + (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := rfl) else elabCommand <| ← set_option hygiene false in `(command| @[simp] lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = (($compTerm) g.hom f.hom) := + (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := rfl) - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) + match customOfHom? with + | some (binders, homTy, _, _) => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := + rfl) + | none => + if useToAdditive then + elabCommand <| ← set_option hygiene false in `(command| + @[to_additive (attr := simp), simp] + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) + else + elabCommand <| ← set_option hygiene false in `(command| + @[simp] + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) if useToAdditive then elabCommand <| ← set_option hygiene false in `(command| diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 12f32d0f009bc4..097b73fbca5491 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -60,7 +60,7 @@ mk_concrete_category TestCat Fun Fun.id Fun.comp #guard_msgs in #check TestCat.instConcreteCategory -/-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X.Hom Y) : X.Fun Y -/ +/-- info: TestCat.Hom.hom.{u_1} {X Y : TestCat} (f : X ⟶ Y) : X.Fun Y -/ #guard_msgs in #check Hom.hom @@ -185,7 +185,7 @@ info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : M #guard_msgs in #check ModuleTestCat.instConcreteCategory -/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X.Hom Y) : ↑X →ₗ[R] ↑Y -/ +/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : ↑X →ₗ[R] ↑Y -/ #guard_msgs in #check Hom.hom @@ -208,8 +208,10 @@ info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestC #guard_msgs in #check hom_comp -/-- info: ModuleTestCat.hom_ofHom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : ↑X →ₗ[R] ↑Y) : - Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- +info: ModuleTestCat.hom_ofHom.{v, u} {R : Type u} [Ring R] {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] + [Module R Y] (f : X →ₗ[R] Y) : Hom.hom (ofHom f) = f +-/ #guard_msgs in #check hom_ofHom @@ -309,7 +311,7 @@ namespace MultiplicativeTestCat #guard_msgs in #check MultiplicativeTestCat.instConcreteCategory -/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X.Hom Y) : ↑X →* ↑Y -/ +/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ↑X →* ↑Y -/ #guard_msgs in #check Hom.hom @@ -326,8 +328,9 @@ namespace MultiplicativeTestCat #guard_msgs in #check hom_comp -/-- info: MultiplicativeTestCat.hom_ofHom.{u_1} {X Y : MultiplicativeTestCat} (f : ↑X →* ↑Y) : - Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- +info: MultiplicativeTestCat.hom_ofHom.{u} {X Y : Type u} [Monoid X] [Monoid Y] (f : X →* Y) : Hom.hom (ofHom f) = f +-/ #guard_msgs in #check hom_ofHom @@ -371,7 +374,7 @@ namespace AdditiveTestCat #guard_msgs in #check AdditiveTestCat.instConcreteCategory -/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X.Hom Y) : ↑X →+ ↑Y -/ +/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ↑X →+ ↑Y -/ #guard_msgs in #check Hom.hom @@ -388,7 +391,7 @@ namespace AdditiveTestCat #guard_msgs in #check hom_comp -/-- info: AdditiveTestCat.hom_ofHom.{u_1} {X Y : AdditiveTestCat} (f : ↑X →+ ↑Y) : Hom.hom (ConcreteCategory.ofHom f) = f -/ +/-- info: AdditiveTestCat.hom_ofHom.{u} {X Y : Type u} [AddMonoid X] [AddMonoid Y] (f : X →+ Y) : Hom.hom (ofHom f) = f -/ #guard_msgs in #check hom_ofHom From 380d32fac659ec7ec5bbd6e73ed883ff35279b68 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Fri, 1 May 2026 00:00:53 -0600 Subject: [PATCH 26/34] chore: simplify mk_concrete_category generated rhs --- .../CategoryTheory/MkConcreteCategory.lean | 392 +++++++++--------- Mathlib/Tactic/DSimpPercent.lean | 25 -- .../CategoryTheory/MkConcreteCategory.lean | 10 +- 3 files changed, 197 insertions(+), 230 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index cddd0f3673379a..13e236b22542bd 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -12,40 +12,79 @@ public import Mathlib.Tactic.ToAdditive # The `mk_concrete_category` command `mk_concrete_category C FC id comp` generates the standard initial boilerplate for a concrete -category whose morphisms are modeled by a bundled function type `FC`. The identity term is applied -to an object, and the composition term is applied to the underlying morphism of the second -categorical morphism and then to the underlying morphism of the first. +category whose morphisms are modeled by a bundled function type `FC`. The identity term is expected +to be of the form `(X : C) → FC X X` and the composition term is expected to be of the form +`{X Y Z : C} → FC Y Z → FC X Y → FC X Z`. The command is intended to be run in the namespace of the category it is defining. It creates a -wrapper morphism structure `Hom`, with private field `Hom.hom'`, and uses it as the -categorical morphism type. It then creates: +one-field structure `Hom` which wraps a term of `FC`, with private field `Hom.hom'`, and uses it as +the type of morphisms in the category. It then creates: * `instCategory`, the `Category` instance with `id X = id X` and `comp f g = comp g.hom' f.hom'`; * `instConcreteCategory`, the `ConcreteCategory C FC` instance; -* `Hom.hom`, an abbreviation for the `ConcreteCategory.hom` projection; -* `Hom.Simps.hom`, so `simps` uses the public concrete morphism projection; +* `Hom.hom`, an abbreviation for the `ConcreteCategory.hom` projection from morphisms to `FC`; +* `Hom.Simps.hom`, so `simps` uses the public projection `hom` instead of the private `hom'`; * `ofHom`, a public abbreviation for `ConcreteCategory.ofHom`; -* simp lemmas `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. +* dsimp lemmas `hom_id`, `hom_comp`, `hom_ofHom`, and `ofHom_hom`. -For example, the plain command +For example, the code ```lean -mk_concrete_category TestCat Fun Fun.id (Fun.comp · ·) +structure TestCat where + α : Type u + +namespace TestCat + +@[ext] +structure Fun (X Y : TestCat.{u}) where + toFun : X.α → Y.α + +instance (X Y : TestCat.{u}) : FunLike (Fun X Y) X.α Y.α where + coe := Fun.toFun + coe_injective' _ _ _ := by aesop + +protected def Fun.id (X : TestCat.{u}) : Fun X X where + toFun := id + +protected def Fun.comp {X Y Z : TestCat.{u}} (g : Fun Y Z) (f : Fun X Y) : Fun X Z where + toFun := g.toFun ∘ f.toFun + +mk_concrete_category TestCat Fun Fun.id Fun.comp ``` -where `Fun.comp : Y.Fun Z → X.Fun Y → X.Fun Z`, generates an API where +generates an API where `Hom.hom : X.Hom Y → X.Fun Y`, `ofHom : X.Fun Y → (X ⟶ Y)`, `hom_id : Hom.hom (𝟙 X) = Fun.id X`, and `hom_comp : Hom.hom (f ≫ g) = Fun.comp (Hom.hom g) (Hom.hom f)`. For bundled categories whose public constructor should take unbundled objects, `with_of_hom` -customizes only the generated `ofHom` signature. The underlying `ConcreteCategory.ofHom` lemma still -uses bundled objects. +customizes the generated `ofHom` and `hom_ofHom`. ```lean -mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) - (fun _ => LinearMap.id) (LinearMap.comp · ·) +variable (R : Type u) [Ring R] + +structure ModuleTestCat where + carrier : Type v + [isAddCommGroup : AddCommGroup carrier] + [isModule : Module R carrier] + +attribute [instance] ModuleTestCat.isAddCommGroup +attribute [instance 1100] ModuleTestCat.isModule + +namespace ModuleTestCat + +abbrev of (R : Type u) [Ring R] (M : Type v) [AddCommGroup M] [Module R M] : + ModuleTestCat R := + ⟨M⟩ + +instance : CoeSort (ModuleTestCat.{v} R) (Type v) := + ⟨ModuleTestCat.carrier⟩ + +attribute [coe] ModuleTestCat.carrier + +variable {R} in +mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) ``` @@ -65,10 +104,45 @@ corresponding additive category data in one command. The elaborator first enters namespace and generates the additive concrete category, then enters the multiplicative namespace and generates the multiplicative one. This is useful for commands such as the test case generating both `MultiplicativeTestCat` with homs `X →* Y` and `AdditiveTestCat` with homs `X →+ Y`, including their -matching `ofHom`, `hom_id`, and `hom_comp` declarations. +matching `ofHom`, `hom_id`, and `hom_comp` declarations: + +```lean +structure AdditiveTestCat where + carrier : Type u + [str : AddMonoid carrier] + +@[to_additive AdditiveTestCat] +structure MultiplicativeTestCat where + carrier : Type u + [str : Monoid carrier] + +attribute [instance] AdditiveTestCat.str MultiplicativeTestCat.str + +namespace MultiplicativeTestCat + +@[to_additive] +abbrev of (M : Type u) [Monoid M] : MultiplicativeTestCat := + ⟨M⟩ + +@[to_additive instCoeSortAdditiveTestCat] +instance instCoeSort : CoeSort MultiplicativeTestCat (Type u) := + ⟨MultiplicativeTestCat.carrier⟩ + +end MultiplicativeTestCat + +attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier + +@[to_additive AdditiveTestCat] +mk_concrete_category MultiplicativeTestCat (· →* ·) MonoidHom.id MonoidHom.comp + with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] + hom_type (X →* Y) from (MultiplicativeTestCat.of X) to (MultiplicativeTestCat.of Y) + to_additive AdditiveTestCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] + hom_type (X →+ Y) from (AdditiveTestCat.of X) to (AdditiveTestCat.of Y) +``` -/ -open Lean Elab Command +open Lean Elab Command Term Meta open CategoryTheory namespace Mathlib.Tactic.CategoryTheory @@ -207,6 +281,13 @@ object, and target object. -/ private abbrev CustomOfHomData := TSyntaxArray `Lean.Parser.Term.bracketedBinder × TSyntax `term × TSyntax `term × TSyntax `term +/-- Elaborate a term and beta-reduce it before storing it in a declaration type. -/ +syntax (name := mkConcreteCategoryBeta) "mk_concrete_category_beta% " term : term + +@[term_elab mkConcreteCategoryBeta] +public meta def elabMkConcreteCategoryBeta : TermElab := fun stx expectedType => do + Core.betaReduce (← instantiateMVars (← Term.elabTerm stx[1] expectedType)) + /-! The core generator emits the declarations shared by all forms: `Hom`, the category and concrete category instances, projections and constructors, simps support, and the round-trip lemmas. Most @@ -219,131 +300,83 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT (customOfHom? : Option CustomOfHomData) : CommandElabM Unit := do let useToAdditive := hasToAdditiveAttr mods let addHom? := toAdditiveTarget? mods |>.map fun n => mkCIdent (n ++ `Hom) - if useToAdditive then - match addHom? with - | some addHom => - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - /-- The type of morphisms in this concrete category. -/ - @[to_additive $addHom:ident, ext] - structure Hom (X Y : $cat) where - private mk :: - /-- The underlying bundled morphism. -/ - hom' : ($FC : $cat → $cat → Type _) X Y) - | none => - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - /-- The type of morphisms in this concrete category. -/ - @[to_additive, ext] - structure Hom (X Y : $cat) where - private mk :: - /-- The underlying bundled morphism. -/ - hom' : ($FC : $cat → $cat → Type _) X Y) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - /-- The type of morphisms in this concrete category. -/ - @[ext] - structure Hom (X Y : $cat) where - private mk :: - /-- The underlying bundled morphism. -/ - hom' : ($FC : $cat → $cat → Type _) X Y) - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($idTerm) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($compTerm) g.hom' f.hom')) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instCategory : CategoryTheory.Category $cat where - Hom X Y := Hom (X := X) (Y := Y) - id X := Hom.mk (X := X) (Y := X) (($idTerm) X) - comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($compTerm) g.hom' f.hom')) - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - @[to_additive] - instance instConcreteCategory : - CategoryTheory.ConcreteCategory $cat ($FC : $cat → $cat → Type _) where - hom := fun f => Hom.hom' f - ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f - id_apply := by intros; rfl - comp_apply := by intros; rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - set_option backward.privateInPublic true in - set_option backward.privateInPublic.warn false in - instance instConcreteCategory : - CategoryTheory.ConcreteCategory $cat ($FC : $cat → $cat → Type _) where - hom := fun f => Hom.hom' f - ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f - id_apply := by intros; rfl - comp_apply := by intros; rfl) - - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - /-- Turn a categorical morphism back into its underlying bundled morphism. -/ - @[to_additive] - abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := - CategoryTheory.ConcreteCategory.hom (C := $cat) f) - else - elabCommand <| ← set_option hygiene false in `(command| - /-- Turn a categorical morphism back into its underlying bundled morphism. -/ - abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := - CategoryTheory.ConcreteCategory.hom (C := $cat) f) + let addToAdditiveAttr (decl : Ident) : CommandElabM Unit := do + if useToAdditive then + elabCommand <| ← set_option hygiene false in + `(command| attribute [to_additive] $decl:ident) + let addSimpAttrs (decl : Ident) : CommandElabM Unit := do + if useToAdditive then + elabCommand <| ← set_option hygiene false in + `(command| attribute [to_additive (attr := simp), simp] $decl:ident) + else + elabCommand <| ← set_option hygiene false in + `(command| attribute [simp] $decl:ident) - match customOfHom? with - | some (binders, homTy, source, target) => - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - @[to_additive] - abbrev ofHom $binders:bracketedBinder* - (f : ($homTy)) : $source ⟶ $target := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) - else - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - abbrev ofHom $binders:bracketedBinder* - (f : ($homTy)) : $source ⟶ $target := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + /-- The type of morphisms in this concrete category. -/ + structure Hom (X Y : $cat) where + private mk :: + /-- The underlying bundled morphism. -/ + hom' : ($FC : $cat → $cat → Type _) X Y) + match addHom? with + | some addHom => + elabCommand <| ← set_option hygiene false in + `(command| attribute [to_additive $addHom:ident, ext] Hom) | none => if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - @[to_additive] - abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + elabCommand <| ← set_option hygiene false in + `(command| attribute [to_additive, ext] Hom) else - elabCommand <| ← set_option hygiene false in `(command| - /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ - abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) - - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - /-- Use the public `Hom.hom` projection for `@[simps]` lemmas. -/ - @[to_additive] - def Hom.Simps.hom : (X : $cat) → (Y : $cat) → Hom (X := X) (Y := Y) → - ($FC : $cat → $cat → Type _) X Y := - fun _ _ f => Hom.hom f) - else - elabCommand <| ← set_option hygiene false in `(command| - /-- Use the public `Hom.hom` projection for `@[simps]` lemmas. -/ - def Hom.Simps.hom : (X : $cat) → (Y : $cat) → Hom (X := X) (Y := Y) → - ($FC : $cat → $cat → Type _) X Y := - fun _ _ f => Hom.hom f) + elabCommand <| ← set_option hygiene false in + `(command| attribute [ext] Hom) + + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instCategory : CategoryTheory.Category $cat where + Hom X Y := Hom (X := X) (Y := Y) + id X := Hom.mk (X := X) (Y := X) (($idTerm) X) + comp {X Y Z} f g := Hom.mk (X := X) (Y := Z) (($compTerm) g.hom' f.hom')) + addToAdditiveAttr (mkIdent `instCategory) + + elabCommand <| ← set_option hygiene false in `(command| + set_option backward.privateInPublic true in + set_option backward.privateInPublic.warn false in + instance instConcreteCategory : + CategoryTheory.ConcreteCategory $cat ($FC : $cat → $cat → Type _) where + hom := fun f => Hom.hom' f + ofHom := fun {X Y} f => Hom.mk (X := X) (Y := Y) f + id_apply := by intros; rfl + comp_apply := by intros; rfl) + addToAdditiveAttr (mkIdent `instConcreteCategory) + + elabCommand <| ← set_option hygiene false in `(command| + /-- Turn a categorical morphism back into its underlying bundled morphism. -/ + abbrev Hom.hom {X Y : $cat} (f : X ⟶ Y) := + CategoryTheory.ConcreteCategory.hom (C := $cat) f) + addToAdditiveAttr (mkIdent `Hom.hom) + + match customOfHom? with + | some (binders, homTy, source, target) => + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom $binders:bracketedBinder* + (f : ($homTy)) : $source ⟶ $target := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + | none => + elabCommand <| ← set_option hygiene false in `(command| + /-- Typecheck a bundled morphism as a morphism in this concrete category. -/ + abbrev ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : X ⟶ Y := + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f) + addToAdditiveAttr (mkIdent `ofHom) + + elabCommand <| ← set_option hygiene false in `(command| + /-- Use the public `Hom.hom` projection for `@[simps]` lemmas. -/ + def Hom.Simps.hom : (X : $cat) → (Y : $cat) → Hom (X := X) (Y := Y) → + ($FC : $cat → $cat → Type _) X Y := + fun _ _ f => Hom.hom f) + addToAdditiveAttr (mkIdent `Hom.Simps.hom) elabCommand <| ← set_option hygiene false in `(command| initialize_simps_projections Hom (hom' → hom)) @@ -353,68 +386,35 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT initialize_simps_projections $addHom:ident (hom' → hom)) | none => pure () - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = dsimp'% (($idTerm) X) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_id {X : $cat} : (𝟙 X : X ⟶ X).hom = dsimp'% (($idTerm) X) := - rfl) - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : - (f ≫ g).hom = dsimp'% (($compTerm) g.hom f.hom) := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + lemma hom_id {X : $cat} : + (𝟙 X : X ⟶ X).hom = mk_concrete_category_beta% (($idTerm) X) := + rfl) + addSimpAttrs (mkIdent `hom_id) + + elabCommand <| ← set_option hygiene false in `(command| + lemma hom_comp {X Y Z : $cat} (f : X ⟶ Y) (g : Y ⟶ Z) : + (f ≫ g).hom = mk_concrete_category_beta% (($compTerm) g.hom f.hom) := + rfl) + addSimpAttrs (mkIdent `hom_comp) match customOfHom? with | some (binders, homTy, _, _) => - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + lemma hom_ofHom $binders:bracketedBinder* (f : ($homTy)) : (ofHom f).hom = f := + rfl) | none => - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : - (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := - rfl) - - if useToAdditive then - elabCommand <| ← set_option hygiene false in `(command| - @[to_additive (attr := simp), simp] - lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := - rfl) - else - elabCommand <| ← set_option hygiene false in `(command| - @[simp] - lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : - CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := - rfl) + elabCommand <| ← set_option hygiene false in `(command| + lemma hom_ofHom {X Y : $cat} (f : ($FC : $cat → $cat → Type _) X Y) : + (CategoryTheory.ConcreteCategory.ofHom (C := $cat) f).hom = f := + rfl) + addSimpAttrs (mkIdent `hom_ofHom) + + elabCommand <| ← set_option hygiene false in `(command| + lemma ofHom_hom {X Y : $cat} (f : X ⟶ Y) : + CategoryTheory.ConcreteCategory.ofHom (C := $cat) f.hom = f := + rfl) + addSimpAttrs (mkIdent `ofHom_hom) /-! The remaining elaborators parse their surface syntax and delegate to the core generator. The diff --git a/Mathlib/Tactic/DSimpPercent.lean b/Mathlib/Tactic/DSimpPercent.lean index 481ba581841b2b..360c8dccdcc189 100644 --- a/Mathlib/Tactic/DSimpPercent.lean +++ b/Mathlib/Tactic/DSimpPercent.lean @@ -61,29 +61,4 @@ def dsimpPercentElaborator : TermElab := fun stx expectedType => do dsimp e go { elaborator := .anonymous } |>.run' { goals := [fresh.mvarId!] } -/-- -`dsimp'% […] t` does the same as `dsimp% […] t`, but doesn't throw an error if `dsimp` makes no -progress. --/ -syntax (name := dsimpPercent') "dsimp'%" optConfig (discharger)? (&" only")? - (" [" withoutPosition((simpErase <|> simpLemma),*,?) "]")? ppSpace term : term - -@[term_elab dsimpPercent', inherit_doc dsimpPercent'] -def dsimpPercentElaborator' : TermElab := fun stx expectedType => do - let fresh ← mkFreshExprMVar default - let go : TacticM Expr := do - let e ← Term.elabTerm stx[5] expectedType - -- `stx` has the same shape as a normal `dsimp` call, so we can pass it to `mkSimpContext`. - let { ctx, simprocs, .. } ← mkSimpContext stx (eraseLocal := false) (kind := .dsimp) - let dsimp (e : Expr) : MetaM Expr := do - -- Ensure that only instantiating metavariables isn't counted as progress. - let e ← instantiateMVars e - let (dsimpResult, _) ← Meta.dsimp e ctx simprocs - return dsimpResult - if ← isProof e then - mkExpectedTypeHint e (← dsimp (← inferType e)) - else - dsimp e - go { elaborator := .anonymous } |>.run' { goals := [fresh.mvarId!] } - end Mathlib.Tactic diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 097b73fbca5491..1074094d65c54a 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -13,9 +13,7 @@ open CategoryTheory universe v u -/-- A test category whose morphisms are wrappers around functions. -/ structure TestCat where - /-- The underlying type. -/ α : Type u namespace TestCat @@ -136,7 +134,6 @@ attribute [instance 1100] ModuleTestCat.isModule namespace ModuleTestCat -/-- Construct a bundled `ModuleTestCat` from the underlying type and typeclass. -/ abbrev of (R : Type u) [Ring R] (M : Type v) [AddCommGroup M] [Module R M] : ModuleTestCat R := ⟨M⟩ @@ -259,16 +256,12 @@ info: ModuleTestCat.morphism_hom.{v, u} (R : Type u) [Ring R] (X : ModuleTestCat end ModuleTestCat -/-- Additive test category for the `to_additive` form of `mk_concrete_category`. -/ structure AdditiveTestCat where - /-- The underlying type. -/ carrier : Type u [str : AddMonoid carrier] -/-- Multiplicative test category for the `to_additive` form of `mk_concrete_category`. -/ @[to_additive AdditiveTestCat] structure MultiplicativeTestCat where - /-- The underlying type. -/ carrier : Type u [str : Monoid carrier] @@ -276,8 +269,7 @@ attribute [instance] AdditiveTestCat.str MultiplicativeTestCat.str namespace MultiplicativeTestCat -/-- Construct a bundled `MultiplicativeTestCat` from the underlying type and typeclass. -/ -@[to_additive /-- Construct a bundled `AdditiveTestCat` from the underlying type and typeclass. -/] +@[to_additive] abbrev of (M : Type u) [Monoid M] : MultiplicativeTestCat := ⟨M⟩ From 7f8ce481519a67a1daba3ddd1f0d726dcc34ff49 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Fri, 1 May 2026 00:17:25 -0600 Subject: [PATCH 27/34] clarify simps changes --- Mathlib/Tactic/Simps/Basic.lean | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Mathlib/Tactic/Simps/Basic.lean b/Mathlib/Tactic/Simps/Basic.lean index e56eeef4398471..9b235f2de64f06 100644 --- a/Mathlib/Tactic/Simps/Basic.lean +++ b/Mathlib/Tactic/Simps/Basic.lean @@ -669,6 +669,10 @@ def findProjection (str : Name) (proj : ParsedProjectionData) throwError "Invalid custom projection:{indentExpr customProj}\n\ Expression is not definitionally equal to {indentExpr rawExpr}" else + -- `simps` usually insists that a custom projection has exactly the same type as the raw + -- projection. This is too strict when the raw projection has implicit arguments in a + -- different order from the public projection we want to use. Accept this case if, after + -- opening both `forall` telescopes, the argument domains and final bodies match. let compatibleType ← MetaM.run' do try let (customArgs, _, customBody) ← forallMetaTelescopeReducing customProjType @@ -684,14 +688,19 @@ def findProjection (str : Name) (proj : ParsedProjectionData) isDefEq customBody rawBody catch _ => pure false - let isHomRenameWithMatchingArity ← MetaM.run' do + -- In some cases the raw and custom projections are definitionally equal only after they + -- are applied to their arguments, while the comparison of their unapplied types above is + -- too rigid. We allow the custom projection through when the number of arguments agrees; + -- the generated projection theorem is elaborated with `customProj`, so an invalid + -- replacement will still be rejected later. + let isRenameWithMatchingArity ← MetaM.run' do try let (customArgs, _, _) ← forallMetaTelescopeReducing customProjType let (rawArgs, _, _) ← forallMetaTelescopeReducing rawExprType pure <| proj.strName == `hom' && proj.newName == `hom && customArgs.size == rawArgs.size catch _ => pure false - if compatibleType || isHomRenameWithMatchingArity then + if compatibleType || isRenameWithMatchingArity then _ ← MetaM.run' <| TermElabM.run' <| addTermInfo proj.newStx <| ← mkConstWithLevelParams customName pure { proj with expr? := some customProj, projNrs := nrs, isCustom := true } From f5bfb98438c7d7deb06305a3a58db48b85c483df Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Fri, 1 May 2026 08:22:41 -0600 Subject: [PATCH 28/34] Apply suggestion from @dagurtomas --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 13e236b22542bd..6d9a098fee39f2 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -284,7 +284,7 @@ private abbrev CustomOfHomData := /-- Elaborate a term and beta-reduce it before storing it in a declaration type. -/ syntax (name := mkConcreteCategoryBeta) "mk_concrete_category_beta% " term : term -@[term_elab mkConcreteCategoryBeta] +@[term_elab mkConcreteCategoryBeta, inherit_doc mkConcreteCategoryBeta] public meta def elabMkConcreteCategoryBeta : TermElab := fun stx expectedType => do Core.betaReduce (← instantiateMVars (← Term.elabTerm stx[1] expectedType)) From 58900fff25b9bba8b1e3414987cc5bdaee80d140 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Fri, 1 May 2026 08:23:16 -0600 Subject: [PATCH 29/34] Apply suggestion from @dagurtomas --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 13e236b22542bd..6d9a098fee39f2 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -284,7 +284,7 @@ private abbrev CustomOfHomData := /-- Elaborate a term and beta-reduce it before storing it in a declaration type. -/ syntax (name := mkConcreteCategoryBeta) "mk_concrete_category_beta% " term : term -@[term_elab mkConcreteCategoryBeta] +@[term_elab mkConcreteCategoryBeta, inherit_doc mkConcreteCategoryBeta] public meta def elabMkConcreteCategoryBeta : TermElab := fun stx expectedType => do Core.betaReduce (← instantiateMVars (← Term.elabTerm stx[1] expectedType)) From 5a029053462a8df3ba1cfd85456526be020d043c Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 6 May 2026 08:23:30 -0600 Subject: [PATCH 30/34] Update Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean Co-authored-by: Eric Wieser --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 6d9a098fee39f2..202876e2647a31 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -380,11 +380,9 @@ private meta def elabMkConcreteCategoryCore (mods : Syntax) (cat FC idTerm compT elabCommand <| ← set_option hygiene false in `(command| initialize_simps_projections Hom (hom' → hom)) - match addHom? with - | some addHom => - elabCommand <| ← set_option hygiene false in `(command| - initialize_simps_projections $addHom:ident (hom' → hom)) - | none => pure () + if let some addHom := addHom? then + elabCommand <| ← set_option hygiene false in `(command| + initialize_simps_projections $addHom:ident (hom' → hom)) elabCommand <| ← set_option hygiene false in `(command| lemma hom_id {X : $cat} : From 15a17a8e237e5cb056a6c44183f4da51af6d4fa3 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 6 May 2026 09:08:10 -0600 Subject: [PATCH 31/34] fix error --- Mathlib/Topology/Category/TopPair.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Mathlib/Topology/Category/TopPair.lean b/Mathlib/Topology/Category/TopPair.lean index 0ab7c2198d79c0..b2637bd14f5d58 100644 --- a/Mathlib/Topology/Category/TopPair.lean +++ b/Mathlib/Topology/Category/TopPair.lean @@ -52,7 +52,7 @@ abbrev of {A X : TopCat.{u}} (f : A ⟶ X) (h : Topology.IsEmbedding f) : TopPai /-- Constructor for a topological pair (X, A) where A ⊆ X. -/ abbrev ofSubset {X : TopCat.{u}} (A : Set X) : TopPair.{u} := TopPair.of (A := (TopCat.of A)) - (X := X) ⟨{ toFun := Subtype.val }⟩ Topology.IsEmbedding.subtypeVal + (X := X) (TopCat.ofHom { toFun := Subtype.val }) Topology.IsEmbedding.subtypeVal /-- Constructs the topological pair `(X, ∅)` from `X : TopCat`. -/ abbrev ofTopCat (X : TopCat.{u}) : TopPair.{u} := From 87029ed9d1da47278ef5f8f0170f94d76c1f8eab Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 6 May 2026 14:28:18 -0600 Subject: [PATCH 32/34] revert change to simps --- .../CategoryTheory/MkConcreteCategory.lean | 17 +++- Mathlib/Tactic/Simps/Basic.lean | 44 +--------- .../CategoryTheory/MkConcreteCategory.lean | 88 ++++++++++++------- 3 files changed, 73 insertions(+), 76 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 202876e2647a31..6d8813efe7013a 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -220,11 +220,24 @@ running the same core generator there. These helpers keep the namespace checks a commands in one place. -/ +/-- The head identifier of a term, allowing explicit universe syntax such as `C.{u}`. -/ +private meta partial def headTermIdent? (stx : Syntax) : Option Name := + if stx.isIdent then + some stx.getId + else + match stx with + | .node _ k args => + if k == ``Lean.Parser.Term.explicitUniv then + args[0]?.bind headTermIdent? + else + none + | _ => none + /-- Turn a category term from a `to_additive` form into the namespace identifier to generate in. -/ private meta def categoryNamespaceIdent (cat : TSyntax `term) (message : String) : CommandElabM Ident := do - if cat.raw.isIdent then - pure <| mkIdent cat.raw.getId + if let some n := headTermIdent? cat.raw then + pure <| mkIdent n else throwErrorAt cat message diff --git a/Mathlib/Tactic/Simps/Basic.lean b/Mathlib/Tactic/Simps/Basic.lean index 9b235f2de64f06..ab74f5858f6c87 100644 --- a/Mathlib/Tactic/Simps/Basic.lean +++ b/Mathlib/Tactic/Simps/Basic.lean @@ -669,46 +669,10 @@ def findProjection (str : Name) (proj : ParsedProjectionData) throwError "Invalid custom projection:{indentExpr customProj}\n\ Expression is not definitionally equal to {indentExpr rawExpr}" else - -- `simps` usually insists that a custom projection has exactly the same type as the raw - -- projection. This is too strict when the raw projection has implicit arguments in a - -- different order from the public projection we want to use. Accept this case if, after - -- opening both `forall` telescopes, the argument domains and final bodies match. - let compatibleType ← MetaM.run' do - try - let (customArgs, _, customBody) ← forallMetaTelescopeReducing customProjType - let (rawArgs, _, rawBody) ← forallMetaTelescopeReducing rawExprType - if customArgs.size != rawArgs.size then - pure false - else - let domainsCompatible ← customArgs.zip rawArgs |>.allM fun (customArg, rawArg) => do - isDefEq (← inferType customArg) (← inferType rawArg) - if !domainsCompatible then - pure false - else - isDefEq customBody rawBody - catch _ => - pure false - -- In some cases the raw and custom projections are definitionally equal only after they - -- are applied to their arguments, while the comparison of their unapplied types above is - -- too rigid. We allow the custom projection through when the number of arguments agrees; - -- the generated projection theorem is elaborated with `customProj`, so an invalid - -- replacement will still be rejected later. - let isRenameWithMatchingArity ← MetaM.run' do - try - let (customArgs, _, _) ← forallMetaTelescopeReducing customProjType - let (rawArgs, _, _) ← forallMetaTelescopeReducing rawExprType - pure <| proj.strName == `hom' && proj.newName == `hom && customArgs.size == rawArgs.size - catch _ => - pure false - if compatibleType || isRenameWithMatchingArity then - _ ← MetaM.run' <| TermElabM.run' <| addTermInfo proj.newStx <| - ← mkConstWithLevelParams customName - pure { proj with expr? := some customProj, projNrs := nrs, isCustom := true } - else - throwError "Invalid custom projection:{indentExpr customProj}\n\ - Expression has different type than {str ++ proj.strName}. Given type:\ - {indentExpr customProjType}\nExpected type:{indentExpr rawExprType}\n\ - Note: make sure order of implicit arguments is exactly the same." + throwError "Invalid custom projection:{indentExpr customProj}\n\ + Expression has different type than {str ++ proj.strName}. Given type:\ + {indentExpr customProjType}\nExpected type:{indentExpr rawExprType}\n\ + Note: make sure order of implicit arguments is exactly the same." | _ => _ ← MetaM.run' <| TermElabM.run' <| addTermInfo proj.newStx rawExpr pure {proj with expr? := some rawExpr, projNrs := nrs} diff --git a/MathlibTest/CategoryTheory/MkConcreteCategory.lean b/MathlibTest/CategoryTheory/MkConcreteCategory.lean index 1074094d65c54a..ed56500b4be18a 100644 --- a/MathlibTest/CategoryTheory/MkConcreteCategory.lean +++ b/MathlibTest/CategoryTheory/MkConcreteCategory.lean @@ -144,45 +144,49 @@ instance : CoeSort (ModuleTestCat.{v} R) (Type v) := attribute [coe] ModuleTestCat.carrier variable {R} in -mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp +mk_concrete_category (ModuleTestCat.{v} R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) -/-- info: ModuleTestCat.Hom.{u, u_1, u_2} {R : Type u} [Ring R] (X : ModuleTestCat R) (Y : ModuleTestCat R) : Type (max u_1 u_2) -/ +/-- info: ModuleTestCat.Hom.{v, u} {R : Type u} [Ring R] (X Y : ModuleTestCat R) : Type v -/ #guard_msgs in #check Hom /-- -info: ModuleTestCat.Hom.mk.{u, u_1, u_2} {R : Type u} [Ring R] {X : ModuleTestCat R} {Y : ModuleTestCat R} - (hom' : ↑X →ₗ[R] ↑Y) : X.Hom Y +info: ModuleTestCat.Hom.mk.{v, u} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (hom' : ↑X →ₗ[R] ↑Y) : X.Hom Y -/ #guard_msgs in #check Hom.mk /-- -info: ModuleTestCat.Hom.hom'.{u, u_1, u_2} {R : Type u} [Ring R] {X : ModuleTestCat R} {Y : ModuleTestCat R} - (self : X.Hom Y) : ↑X →ₗ[R] ↑Y +info: ModuleTestCat.Hom.hom'.{v, u} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (self : X.Hom Y) : ↑X →ₗ[R] ↑Y -/ #guard_msgs in #check Hom.hom' /-- -info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : ModuleTestCat R} {Y : ModuleTestCat R} - {x y : X.Hom Y} (hom' : x.hom' = y.hom') : x = y +info: ModuleTestCat.Hom.ext.{v, u} {R : Type u} {inst✝ : Ring R} {X Y : ModuleTestCat R} {x y : X.Hom Y} + (hom' : x.hom' = y.hom') : x = y -/ #guard_msgs in #check Hom.ext -/-- info: ModuleTestCat.instCategory.{u, u_1} {R : Type u} [Ring R] : Category.{u_1, max u (u_1 + 1)} (ModuleTestCat R) -/ +/-- +info: ModuleTestCat.instCategory.{v, u} {R : Type u} [Ring R] : Category.{v, max (v + 1) u} (ModuleTestCat R) +-/ #guard_msgs in #check ModuleTestCat.instCategory -/-- info: ModuleTestCat.instConcreteCategory.{u, u_1} {R : Type u} [Ring R] : - ConcreteCategory (ModuleTestCat R) fun x1 x2 => ↑x1 →ₗ[R] ↑x2 -/ +/-- +info: ModuleTestCat.instConcreteCategory.{v, u} {R : Type u} [Ring R] : + ConcreteCategory (ModuleTestCat R) fun x1 x2 => ↑x1 →ₗ[R] ↑x2 +-/ #guard_msgs in #check ModuleTestCat.instConcreteCategory -/-- info: ModuleTestCat.Hom.hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : ↑X →ₗ[R] ↑Y -/ +/-- +info: ModuleTestCat.Hom.hom.{v, u} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : ↑X →ₗ[R] ↑Y +-/ #guard_msgs in #check Hom.hom @@ -193,13 +197,13 @@ info: ModuleTestCat.Hom.ext.{u, u_1, u_2} {R : Type u} {inst✝ : Ring R} {X : M /-- -info: ModuleTestCat.hom_id.{u, u_1} {R : Type u} [Ring R] {X : ModuleTestCat R} : Hom.hom (𝟙 X) = LinearMap.id +info: ModuleTestCat.hom_id.{v, u} {R : Type u} [Ring R] {X : ModuleTestCat R} : Hom.hom (𝟙 X) = LinearMap.id -/ #guard_msgs in #check hom_id /-- -info: ModuleTestCat.hom_comp.{u, u_1} {R : Type u} [Ring R] {X Y Z : ModuleTestCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : +info: ModuleTestCat.hom_comp.{v, u} {R : Type u} [Ring R] {X Y Z : ModuleTestCat R} (f : X ⟶ Y) (g : Y ⟶ Z) : Hom.hom (f ≫ g) = Hom.hom g ∘ₗ Hom.hom f -/ #guard_msgs in @@ -212,8 +216,10 @@ info: ModuleTestCat.hom_ofHom.{v, u} {R : Type u} [Ring R] {X Y : Type v} [AddCo #guard_msgs in #check hom_ofHom -/-- info: ModuleTestCat.ofHom_hom.{u, u_1} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : - ConcreteCategory.ofHom (Hom.hom f) = f -/ +/-- +info: ModuleTestCat.ofHom_hom.{v, u} {R : Type u} [Ring R] {X Y : ModuleTestCat R} (f : X ⟶ Y) : + ConcreteCategory.ofHom (Hom.hom f) = f +-/ #guard_msgs in #check ofHom_hom @@ -282,28 +288,30 @@ end MultiplicativeTestCat attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier @[to_additive AdditiveTestCat] -mk_concrete_category MultiplicativeTestCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category MultiplicativeTestCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] hom_type (X →* Y) from (MultiplicativeTestCat.of X) to (MultiplicativeTestCat.of Y) - to_additive AdditiveTestCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AdditiveTestCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] hom_type (X →+ Y) from (AdditiveTestCat.of X) to (AdditiveTestCat.of Y) namespace MultiplicativeTestCat -/-- info: MultiplicativeTestCat.Hom.{u_1, u_2} (X : MultiplicativeTestCat) (Y : MultiplicativeTestCat) : Type (max u_1 u_2) -/ +/-- info: MultiplicativeTestCat.Hom.{u} (X Y : MultiplicativeTestCat) : Type u -/ #guard_msgs in #check Hom -/-- info: MultiplicativeTestCat.instCategory.{u_1} : Category.{u_1, u_1 + 1} MultiplicativeTestCat -/ +/-- info: MultiplicativeTestCat.instCategory.{u} : Category.{u, u + 1} MultiplicativeTestCat -/ #guard_msgs in #check MultiplicativeTestCat.instCategory -/-- info: MultiplicativeTestCat.instConcreteCategory.{u_1} : ConcreteCategory MultiplicativeTestCat fun x1 x2 => ↑x1 →* ↑x2 -/ +/-- +info: MultiplicativeTestCat.instConcreteCategory.{u} : ConcreteCategory MultiplicativeTestCat fun x1 x2 => ↑x1 →* ↑x2 +-/ #guard_msgs in #check MultiplicativeTestCat.instConcreteCategory -/-- info: MultiplicativeTestCat.Hom.hom.{u_1} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ↑X →* ↑Y -/ +/-- info: MultiplicativeTestCat.Hom.hom.{u} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ↑X →* ↑Y -/ #guard_msgs in #check Hom.hom @@ -311,12 +319,16 @@ namespace MultiplicativeTestCat #guard_msgs in #check ofHom -/-- info: MultiplicativeTestCat.hom_id.{u_1} {X : MultiplicativeTestCat} : Hom.hom (𝟙 X) = MonoidHom.id ↑X -/ +/-- +info: MultiplicativeTestCat.hom_id.{u} {X : MultiplicativeTestCat} : Hom.hom (𝟙 X) = MonoidHom.id ↑X +-/ #guard_msgs in #check hom_id -/-- info: MultiplicativeTestCat.hom_comp.{u_1} {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) -/ +/-- +info: MultiplicativeTestCat.hom_comp.{u} {X Y Z : MultiplicativeTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) +-/ #guard_msgs in #check hom_comp @@ -326,7 +338,9 @@ info: MultiplicativeTestCat.hom_ofHom.{u} {X Y : Type u} [Monoid X] [Monoid Y] ( #guard_msgs in #check hom_ofHom -/-- info: MultiplicativeTestCat.ofHom_hom.{u_1} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f -/ +/-- +info: MultiplicativeTestCat.ofHom_hom.{u} {X Y : MultiplicativeTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f +-/ #guard_msgs in #check ofHom_hom @@ -354,19 +368,21 @@ end MultiplicativeTestCat namespace AdditiveTestCat -/-- info: AdditiveTestCat.Hom.{u_1, u_2} (X : AdditiveTestCat) (Y : AdditiveTestCat) : Type (max u_1 u_2) -/ +/-- info: AdditiveTestCat.Hom.{u} (X Y : AdditiveTestCat) : Type u -/ #guard_msgs in #check Hom -/-- info: AdditiveTestCat.instCategory.{u_1} : Category.{u_1, u_1 + 1} AdditiveTestCat -/ +/-- info: AdditiveTestCat.instCategory.{u} : Category.{u, u + 1} AdditiveTestCat -/ #guard_msgs in #check AdditiveTestCat.instCategory -/-- info: AdditiveTestCat.instConcreteCategory.{u_1} : ConcreteCategory AdditiveTestCat fun x1 x2 => ↑x1 →+ ↑x2 -/ +/-- +info: AdditiveTestCat.instConcreteCategory.{u} : ConcreteCategory AdditiveTestCat fun x1 x2 => ↑x1 →+ ↑x2 +-/ #guard_msgs in #check AdditiveTestCat.instConcreteCategory -/-- info: AdditiveTestCat.Hom.hom.{u_1} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ↑X →+ ↑Y -/ +/-- info: AdditiveTestCat.Hom.hom.{u} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ↑X →+ ↑Y -/ #guard_msgs in #check Hom.hom @@ -374,12 +390,14 @@ namespace AdditiveTestCat #guard_msgs in #check ofHom -/-- info: AdditiveTestCat.hom_id.{u_1} {X : AdditiveTestCat} : Hom.hom (𝟙 X) = AddMonoidHom.id ↑X -/ +/-- info: AdditiveTestCat.hom_id.{u} {X : AdditiveTestCat} : Hom.hom (𝟙 X) = AddMonoidHom.id ↑X -/ #guard_msgs in #check hom_id -/-- info: AdditiveTestCat.hom_comp.{u_1} {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : - Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) -/ +/-- +info: AdditiveTestCat.hom_comp.{u} {X Y Z : AdditiveTestCat} (f : X ⟶ Y) (g : Y ⟶ Z) : + Hom.hom (f ≫ g) = (Hom.hom g).comp (Hom.hom f) +-/ #guard_msgs in #check hom_comp @@ -387,7 +405,9 @@ namespace AdditiveTestCat #guard_msgs in #check hom_ofHom -/-- info: AdditiveTestCat.ofHom_hom.{u_1} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f -/ +/-- +info: AdditiveTestCat.ofHom_hom.{u} {X Y : AdditiveTestCat} (f : X ⟶ Y) : ConcreteCategory.ofHom (Hom.hom f) = f +-/ #guard_msgs in #check ofHom_hom From 79292a0e4e5b719b1288eddf02414bcabb45c988 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 6 May 2026 14:56:14 -0600 Subject: [PATCH 33/34] fix the build --- Mathlib/Algebra/Category/BoolRing.lean | 2 +- Mathlib/Algebra/Category/Grp/Basic.lean | 8 ++++---- Mathlib/Algebra/Category/ModuleCat/Basic.lean | 2 +- Mathlib/Algebra/Category/ModuleCat/Semi.lean | 2 +- Mathlib/Algebra/Category/MonCat/Basic.lean | 8 ++++---- Mathlib/Algebra/Category/Ring/Basic.lean | 8 ++++---- Mathlib/Algebra/Category/Semigrp/Basic.lean | 8 ++++---- Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean | 2 +- Mathlib/Order/Category/BddDistLat.lean | 2 +- Mathlib/Order/Category/BddLat.lean | 2 +- Mathlib/Order/Category/BddOrd.lean | 2 +- Mathlib/Order/Category/BoolAlg.lean | 3 +-- Mathlib/Order/Category/DistLat.lean | 2 +- Mathlib/Order/Category/FinBddDistLat.lean | 2 +- Mathlib/Order/Category/Frm.lean | 2 +- Mathlib/Order/Category/HeytAlg.lean | 2 +- Mathlib/Order/Category/Lat.lean | 2 +- Mathlib/Order/Category/LinOrd.lean | 2 +- Mathlib/Order/Category/PartOrd.lean | 2 +- Mathlib/Order/Category/PartOrdEmb.lean | 2 +- Mathlib/Order/Category/Preord.lean | 2 +- Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean | 4 ++-- Mathlib/Topology/Category/TopCat/Basic.lean | 2 +- Mathlib/Topology/Category/UniformSpace.lean | 2 +- 24 files changed, 37 insertions(+), 38 deletions(-) diff --git a/Mathlib/Algebra/Category/BoolRing.lean b/Mathlib/Algebra/Category/BoolRing.lean index 9d1eccb0b40fb3..c34d7209ecd927 100644 --- a/Mathlib/Algebra/Category/BoolRing.lean +++ b/Mathlib/Algebra/Category/BoolRing.lean @@ -51,7 +51,7 @@ theorem coe_of (α : Type*) [BooleanRing α] : ↥(of α) = α := instance : Inhabited BoolRing := ⟨of PUnit⟩ -mk_concrete_category BoolRing (· →+* ·) RingHom.id RingHom.comp +mk_concrete_category BoolRing.{u} (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [BooleanRing R] [BooleanRing S] hom_type (R →+* S) from (of R) to (of S) diff --git a/Mathlib/Algebra/Category/Grp/Basic.lean b/Mathlib/Algebra/Category/Grp/Basic.lean index 27758a4eea8ff3..0a943dc93a7b50 100644 --- a/Mathlib/Algebra/Category/Grp/Basic.lean +++ b/Mathlib/Algebra/Category/Grp/Basic.lean @@ -61,10 +61,10 @@ abbrev of (M : Type u) [Group M] : GrpCat := ⟨M⟩ end GrpCat @[to_additive AddGrpCat] -mk_concrete_category GrpCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category GrpCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Group X] [Group Y] hom_type (X →* Y) from (GrpCat.of X) to (GrpCat.of Y) - to_additive AddGrpCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AddGrpCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddGroup X] [AddGroup Y] hom_type (X →+ Y) from (AddGrpCat.of X) to (AddGrpCat.of Y) @@ -224,10 +224,10 @@ abbrev of (M : Type u) [CommGroup M] : CommGrpCat := ⟨M⟩ end CommGrpCat @[to_additive AddCommGrpCat] -mk_concrete_category CommGrpCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category CommGrpCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [CommGroup X] [CommGroup Y] hom_type (X →* Y) from (CommGrpCat.of X) to (CommGrpCat.of Y) - to_additive AddCommGrpCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AddCommGrpCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddCommGroup X] [AddCommGroup Y] hom_type (X →+ Y) from (AddCommGrpCat.of X) to (AddCommGrpCat.of Y) diff --git a/Mathlib/Algebra/Category/ModuleCat/Basic.lean b/Mathlib/Algebra/Category/ModuleCat/Basic.lean index 1a72203d47900b..7e703bf708350e 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Basic.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Basic.lean @@ -85,7 +85,7 @@ example (X : Type v) [Ring X] [Module R X] : (of R X : Type v) = X := by with_re example (M : ModuleCat.{v} R) : of R M = M := by with_reducible rfl variable {R} in -mk_concrete_category (ModuleCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) (LinearMap.comp · ·) +mk_concrete_category (ModuleCat.{v} R) (· →ₗ[R] ·) (@LinearMap.id R ·) (LinearMap.comp · ·) with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) diff --git a/Mathlib/Algebra/Category/ModuleCat/Semi.lean b/Mathlib/Algebra/Category/ModuleCat/Semi.lean index db19d2f36c90ba..cc3154c93d4ebe 100644 --- a/Mathlib/Algebra/Category/ModuleCat/Semi.lean +++ b/Mathlib/Algebra/Category/ModuleCat/Semi.lean @@ -83,7 +83,7 @@ example (X : Type v) [Semiring X] [Module R X] : (of R X : Type v) = X := by wit example (M : SemimoduleCat.{v} R) : of R M = M := by with_reducible rfl variable {R} in -mk_concrete_category (SemimoduleCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp +mk_concrete_category (SemimoduleCat.{v} R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommMonoid X] [Module R X] [AddCommMonoid Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) diff --git a/Mathlib/Algebra/Category/MonCat/Basic.lean b/Mathlib/Algebra/Category/MonCat/Basic.lean index 9539f31b492be3..866c74b8bc0e9e 100644 --- a/Mathlib/Algebra/Category/MonCat/Basic.lean +++ b/Mathlib/Algebra/Category/MonCat/Basic.lean @@ -65,10 +65,10 @@ abbrev of (M : Type u) [Monoid M] : MonCat := ⟨M⟩ end MonCat @[to_additive AddMonCat] -mk_concrete_category MonCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category MonCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] hom_type (X →* Y) from (MonCat.of X) to (MonCat.of Y) - to_additive AddMonCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AddMonCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] hom_type (X →+ Y) from (AddMonCat.of X) to (AddMonCat.of Y) @@ -198,10 +198,10 @@ abbrev of (M : Type u) [CommMonoid M] : CommMonCat := ⟨M⟩ end CommMonCat @[to_additive AddCommMonCat] -mk_concrete_category CommMonCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category CommMonCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [CommMonoid X] [CommMonoid Y] hom_type (X →* Y) from (CommMonCat.of X) to (CommMonCat.of Y) - to_additive AddCommMonCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AddCommMonCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddCommMonoid X] [AddCommMonoid Y] hom_type (X →+ Y) from (AddCommMonCat.of X) to (AddCommMonCat.of Y) diff --git a/Mathlib/Algebra/Category/Ring/Basic.lean b/Mathlib/Algebra/Category/Ring/Basic.lean index b97c647788e152..89b6bc47050653 100644 --- a/Mathlib/Algebra/Category/Ring/Basic.lean +++ b/Mathlib/Algebra/Category/Ring/Basic.lean @@ -63,7 +63,7 @@ lemma coe_of (R : Type u) [Semiring R] : (of R : Type u) = R := lemma of_carrier (R : SemiRingCat.{u}) : of R = R := rfl -mk_concrete_category SemiRingCat (· →+* ·) RingHom.id RingHom.comp +mk_concrete_category SemiRingCat.{u} (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [Semiring R] [Semiring S] hom_type (R →+* S) from (SemiRingCat.of R) to (SemiRingCat.of S) @@ -183,7 +183,7 @@ lemma coe_of (R : Type u) [Ring R] : (of R : Type u) = R := lemma of_carrier (R : RingCat.{u}) : of R = R := rfl -mk_concrete_category RingCat (· →+* ·) RingHom.id RingHom.comp +mk_concrete_category RingCat.{u} (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [Ring R] [Ring S] hom_type (R →+* S) from (RingCat.of R) to (RingCat.of S) @@ -312,7 +312,7 @@ lemma coe_of (R : Type u) [CommSemiring R] : (of R : Type u) = R := lemma of_carrier (R : CommSemiRingCat.{u}) : of R = R := rfl -mk_concrete_category CommSemiRingCat (· →+* ·) RingHom.id RingHom.comp +mk_concrete_category CommSemiRingCat.{u} (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [CommSemiring R] [CommSemiring S] hom_type (R →+* S) from (CommSemiRingCat.of R) to (CommSemiRingCat.of S) @@ -438,7 +438,7 @@ lemma coe_of (R : Type u) [CommRing R] : (of R : Type u) = R := lemma of_carrier (R : CommRingCat.{u}) : of R = R := rfl -mk_concrete_category CommRingCat (· →+* ·) RingHom.id RingHom.comp +mk_concrete_category CommRingCat.{u} (· →+* ·) RingHom.id RingHom.comp with_of_hom {R S : Type u} [CommRing R] [CommRing S] hom_type (R →+* S) from (CommRingCat.of R) to (CommRingCat.of S) diff --git a/Mathlib/Algebra/Category/Semigrp/Basic.lean b/Mathlib/Algebra/Category/Semigrp/Basic.lean index b6a05433bf69ea..555db57c36ccdc 100644 --- a/Mathlib/Algebra/Category/Semigrp/Basic.lean +++ b/Mathlib/Algebra/Category/Semigrp/Basic.lean @@ -70,10 +70,10 @@ abbrev of (M : Type u) [Mul M] : MagmaCat := ⟨M⟩ end MagmaCat @[to_additive AddMagmaCat] -mk_concrete_category MagmaCat (· →ₙ* ·) MulHom.id MulHom.comp +mk_concrete_category MagmaCat.{u} (· →ₙ* ·) MulHom.id MulHom.comp with_of_hom {X Y : Type u} [Mul X] [Mul Y] hom_type (X →ₙ* Y) from (MagmaCat.of X) to (MagmaCat.of Y) - to_additive AddMagmaCat (· →ₙ+ ·) AddHom.id AddHom.comp + to_additive AddMagmaCat.{u} (· →ₙ+ ·) AddHom.id AddHom.comp with_of_hom {X Y : Type u} [Add X] [Add Y] hom_type (X →ₙ+ Y) from (AddMagmaCat.of X) to (AddMagmaCat.of Y) @@ -178,10 +178,10 @@ abbrev of (M : Type u) [Semigroup M] : Semigrp := ⟨M⟩ end Semigrp @[to_additive AddSemigrp] -mk_concrete_category Semigrp (· →ₙ* ·) MulHom.id MulHom.comp +mk_concrete_category Semigrp.{u} (· →ₙ* ·) MulHom.id MulHom.comp with_of_hom {X Y : Type u} [Semigroup X] [Semigroup Y] hom_type (X →ₙ* Y) from (Semigrp.of X) to (Semigrp.of Y) - to_additive AddSemigrp (· →ₙ+ ·) AddHom.id AddHom.comp + to_additive AddSemigrp.{u} (· →ₙ+ ·) AddHom.id AddHom.comp with_of_hom {X Y : Type u} [AddSemigroup X] [AddSemigroup Y] hom_type (X →ₙ+ Y) from (AddSemigrp.of X) to (AddSemigrp.of Y) diff --git a/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean b/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean index 0b8f894a8d4fdb..63622951ad3c52 100644 --- a/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean +++ b/Mathlib/Analysis/Normed/Group/SemiNormedGrp.lean @@ -42,7 +42,7 @@ namespace SemiNormedGrp instance : CoeSort SemiNormedGrp Type* where coe X := X.carrier -mk_concrete_category SemiNormedGrp (NormedAddGroupHom · ·) +mk_concrete_category SemiNormedGrp.{u} (NormedAddGroupHom · ·) NormedAddGroupHom.id NormedAddGroupHom.comp with_of_hom {M N : Type u} [SeminormedAddCommGroup M] [SeminormedAddCommGroup N] hom_type (NormedAddGroupHom M N) from (of M) to (of N) diff --git a/Mathlib/Order/Category/BddDistLat.lean b/Mathlib/Order/Category/BddDistLat.lean index 8e6998dc166f17..eb3c8bb09f2406 100644 --- a/Mathlib/Order/Category/BddDistLat.lean +++ b/Mathlib/Order/Category/BddDistLat.lean @@ -48,7 +48,7 @@ abbrev of (α : Type*) [DistribLattice α] [BoundedOrder α] : BddDistLat where theorem coe_of (α : Type*) [DistribLattice α] [BoundedOrder α] : ↥(of α) = α := rfl -mk_concrete_category BddDistLat (BoundedLatticeHom · ·) +mk_concrete_category BddDistLat.{u} (BoundedLatticeHom · ·) (fun (X : BddDistLat) ↦ BoundedLatticeHom.id X) BoundedLatticeHom.comp with_of_hom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [DistribLattice Y] diff --git a/Mathlib/Order/Category/BddLat.lean b/Mathlib/Order/Category/BddLat.lean index 86a5e2ab5c9dfc..99a6aa2fee422f 100644 --- a/Mathlib/Order/Category/BddLat.lean +++ b/Mathlib/Order/Category/BddLat.lean @@ -51,7 +51,7 @@ theorem coe_of (α : Type*) [Lattice α] [BoundedOrder α] : ↥(of α) = α := instance : Inhabited BddLat := ⟨of PUnit⟩ -mk_concrete_category BddLat (BoundedLatticeHom · ·) (fun (X : BddLat) ↦ BoundedLatticeHom.id X) +mk_concrete_category BddLat.{u} (BoundedLatticeHom · ·) (fun (X : BddLat) ↦ BoundedLatticeHom.id X) BoundedLatticeHom.comp with_of_hom {X Y : Type u} [Lattice X] [BoundedOrder X] [Lattice Y] [BoundedOrder Y] hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/BddOrd.lean b/Mathlib/Order/Category/BddOrd.lean index 8f8717c42f63b1..71669c4dac8c6f 100644 --- a/Mathlib/Order/Category/BddOrd.lean +++ b/Mathlib/Order/Category/BddOrd.lean @@ -42,7 +42,7 @@ instance : CoeSort BddOrd Type* := abbrev of (X : Type*) [PartialOrder X] [BoundedOrder X] : BddOrd where carrier := X -mk_concrete_category BddOrd (BoundedOrderHom · ·) (fun (X : BddOrd) ↦ BoundedOrderHom.id X) +mk_concrete_category BddOrd.{u} (BoundedOrderHom · ·) (fun (X : BddOrd) ↦ BoundedOrderHom.id X) BoundedOrderHom.comp with_of_hom {X Y : Type u} [PartialOrder X] [BoundedOrder X] [PartialOrder Y] [BoundedOrder Y] hom_type (BoundedOrderHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/BoolAlg.lean b/Mathlib/Order/Category/BoolAlg.lean index 6e70c94d7b6126..b474b738cd98e6 100644 --- a/Mathlib/Order/Category/BoolAlg.lean +++ b/Mathlib/Order/Category/BoolAlg.lean @@ -42,8 +42,7 @@ instance : CoeSort BoolAlg (Type _) := attribute [coe] BoolAlg.carrier -mk_concrete_category BoolAlg (BoundedLatticeHom · ·) (fun (X : BoolAlg) ↦ BoundedLatticeHom.id X) - BoundedLatticeHom.comp +mk_concrete_category BoolAlg.{u} (BoundedLatticeHom · ·) BoundedLatticeHom.id BoundedLatticeHom.comp with_of_hom {X Y : Type u} [BooleanAlgebra X] [BooleanAlgebra Y] hom_type (BoundedLatticeHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/DistLat.lean b/Mathlib/Order/Category/DistLat.lean index b5a44de695c712..c0b142441f44c8 100644 --- a/Mathlib/Order/Category/DistLat.lean +++ b/Mathlib/Order/Category/DistLat.lean @@ -44,7 +44,7 @@ attribute [coe] DistLat.carrier /-- Construct a bundled `DistLat` from the underlying type and typeclass. -/ abbrev of (X : Type*) [DistribLattice X] : DistLat := ⟨X⟩ -mk_concrete_category DistLat (LatticeHom · ·) (fun (X : DistLat) ↦ LatticeHom.id X) +mk_concrete_category DistLat.{u} (LatticeHom · ·) (fun (X : DistLat) ↦ LatticeHom.id X) LatticeHom.comp with_of_hom {X Y : Type u} [DistribLattice X] [DistribLattice Y] hom_type (LatticeHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/FinBddDistLat.lean b/Mathlib/Order/Category/FinBddDistLat.lean index bfc331aec8430f..1d26cb65387207 100644 --- a/Mathlib/Order/Category/FinBddDistLat.lean +++ b/Mathlib/Order/Category/FinBddDistLat.lean @@ -49,7 +49,7 @@ abbrev of' (α : Type*) [DistribLattice α] [Fintype α] [Nonempty α] : FinBddD carrier := α isBoundedOrder := Fintype.toBoundedOrder α -mk_concrete_category FinBddDistLat (BoundedLatticeHom · ·) +mk_concrete_category FinBddDistLat.{u} (BoundedLatticeHom · ·) (fun (X : FinBddDistLat) ↦ BoundedLatticeHom.id X) BoundedLatticeHom.comp with_of_hom {X Y : Type u} [DistribLattice X] [BoundedOrder X] [Fintype X] diff --git a/Mathlib/Order/Category/Frm.lean b/Mathlib/Order/Category/Frm.lean index a5c369b0e3ecdf..6166e7ff0d0ced 100644 --- a/Mathlib/Order/Category/Frm.lean +++ b/Mathlib/Order/Category/Frm.lean @@ -45,7 +45,7 @@ instance : CoeSort Frm (Type _) := attribute [coe] Frm.carrier -mk_concrete_category Frm (FrameHom · ·) (fun (X : Frm) ↦ FrameHom.id X) FrameHom.comp +mk_concrete_category Frm.{u} (FrameHom · ·) (fun (X : Frm) ↦ FrameHom.id X) FrameHom.comp with_of_hom {X Y : Type u} [Frame X] [Frame Y] hom_type (FrameHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/HeytAlg.lean b/Mathlib/Order/Category/HeytAlg.lean index da71f219b554d6..e5a072d3bc0f23 100644 --- a/Mathlib/Order/Category/HeytAlg.lean +++ b/Mathlib/Order/Category/HeytAlg.lean @@ -41,7 +41,7 @@ attribute [coe] HeytAlg.carrier /-- Construct a bundled `HeytAlg` from the underlying type and typeclass. -/ abbrev of (X : Type*) [HeytingAlgebra X] : HeytAlg := ⟨X⟩ -mk_concrete_category HeytAlg (HeytingHom · ·) (fun (X : HeytAlg) ↦ HeytingHom.id X) +mk_concrete_category HeytAlg.{u} (HeytingHom · ·) (fun (X : HeytAlg) ↦ HeytingHom.id X) HeytingHom.comp with_of_hom {X Y : Type u} [HeytingAlgebra X] [HeytingAlgebra Y] hom_type (HeytingHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/Lat.lean b/Mathlib/Order/Category/Lat.lean index d761abe2c48261..3caba7d2bb6f81 100644 --- a/Mathlib/Order/Category/Lat.lean +++ b/Mathlib/Order/Category/Lat.lean @@ -48,7 +48,7 @@ attribute [coe] Lat.carrier /-- Construct a bundled `Lat` from the underlying type and typeclass. -/ abbrev of (X : Type*) [Lattice X] : Lat := ⟨X⟩ -mk_concrete_category Lat (LatticeHom · ·) (fun (X : Lat) ↦ LatticeHom.id X) LatticeHom.comp +mk_concrete_category Lat.{u} (LatticeHom · ·) (fun (X : Lat) ↦ LatticeHom.id X) LatticeHom.comp with_of_hom {X Y : Type u} [Lattice X] [Lattice Y] hom_type (LatticeHom X Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/LinOrd.lean b/Mathlib/Order/Category/LinOrd.lean index 0119c6498a3c39..40d320be64bc66 100644 --- a/Mathlib/Order/Category/LinOrd.lean +++ b/Mathlib/Order/Category/LinOrd.lean @@ -22,7 +22,7 @@ universe u namespace LinOrd -mk_concrete_category LinOrd (· →o ·) (fun (_ : LinOrd) ↦ OrderHom.id) OrderHom.comp +mk_concrete_category LinOrd.{u} (· →o ·) (fun (_ : LinOrd) ↦ OrderHom.id) OrderHom.comp with_of_hom {X Y : Type u} [LinearOrder X] [LinearOrder Y] hom_type (X →o Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/PartOrd.lean b/Mathlib/Order/Category/PartOrd.lean index d1731fd492b027..119d951ba99aa8 100644 --- a/Mathlib/Order/Category/PartOrd.lean +++ b/Mathlib/Order/Category/PartOrd.lean @@ -40,7 +40,7 @@ instance : CoeSort PartOrd (Type _) := attribute [coe] PartOrd.carrier -mk_concrete_category PartOrd (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp +mk_concrete_category PartOrd.{u} (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp with_of_hom {X Y : Type u} [PartialOrder X] [PartialOrder Y] hom_type (X →o Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/PartOrdEmb.lean b/Mathlib/Order/Category/PartOrdEmb.lean index 75bb377316548c..a14edd143ff034 100644 --- a/Mathlib/Order/Category/PartOrdEmb.lean +++ b/Mathlib/Order/Category/PartOrdEmb.lean @@ -43,7 +43,7 @@ instance : CoeSort PartOrdEmb (Type _) := attribute [coe] PartOrdEmb.carrier -mk_concrete_category PartOrdEmb (· ↪o ·) (fun _ ↦ RelEmbedding.refl _) (fun g f ↦ f.trans g) +mk_concrete_category PartOrdEmb.{u} (· ↪o ·) (fun _ ↦ RelEmbedding.refl _) (fun g f ↦ f.trans g) with_of_hom {X Y : Type u} [PartialOrder X] [PartialOrder Y] hom_type (X ↪o Y) from (of X) to (of Y) diff --git a/Mathlib/Order/Category/Preord.lean b/Mathlib/Order/Category/Preord.lean index 35d3f228148d28..5d7ea4898267f7 100644 --- a/Mathlib/Order/Category/Preord.lean +++ b/Mathlib/Order/Category/Preord.lean @@ -44,7 +44,7 @@ instance : CoeSort Preord (Type u) := attribute [coe] Preord.carrier -mk_concrete_category Preord (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp +mk_concrete_category Preord.{u} (· →o ·) (fun _ ↦ OrderHom.id) OrderHom.comp with_of_hom {X Y : Type u} [Preorder X] [Preorder Y] hom_type (X →o Y) from (of X) to (of Y) diff --git a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean index de539788f36a51..8ec96213c6b373 100644 --- a/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean +++ b/Mathlib/Topology/Algebra/Category/ProfiniteGrp/Basic.lean @@ -91,12 +91,12 @@ lemma ProfiniteGrp.coe_of (G : Type u) [Group G] [TopologicalSpace G] [IsTopolog rfl @[to_additive ProfiniteAddGrp] -mk_concrete_category ProfiniteGrp (· →ₜ* ·) ContinuousMonoidHom.id ContinuousMonoidHom.comp +mk_concrete_category ProfiniteGrp.{u} (· →ₜ* ·) ContinuousMonoidHom.id ContinuousMonoidHom.comp with_of_hom {X Y : Type u} [Group X] [TopologicalSpace X] [IsTopologicalGroup X] [CompactSpace X] [TotallyDisconnectedSpace X] [Group Y] [TopologicalSpace Y] [IsTopologicalGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] hom_type (X →ₜ* Y) from (ProfiniteGrp.of X) to (ProfiniteGrp.of Y) - to_additive ProfiniteAddGrp (· →ₜ+ ·) ContinuousAddMonoidHom.id ContinuousAddMonoidHom.comp + to_additive ProfiniteAddGrp.{u} (· →ₜ+ ·) ContinuousAddMonoidHom.id ContinuousAddMonoidHom.comp with_of_hom {X Y : Type u} [AddGroup X] [TopologicalSpace X] [IsTopologicalAddGroup X] [CompactSpace X] [TotallyDisconnectedSpace X] [AddGroup Y] [TopologicalSpace Y] [IsTopologicalAddGroup Y] [CompactSpace Y] [TotallyDisconnectedSpace Y] diff --git a/Mathlib/Topology/Category/TopCat/Basic.lean b/Mathlib/Topology/Category/TopCat/Basic.lean index db355d29a3a22f..c8b49a1687540b 100644 --- a/Mathlib/Topology/Category/TopCat/Basic.lean +++ b/Mathlib/Topology/Category/TopCat/Basic.lean @@ -64,7 +64,7 @@ lemma coe_of (X : Type u) [TopologicalSpace X] : (of X : Type u) = X := lemma of_carrier (X : TopCat.{u}) : of X = X := rfl -mk_concrete_category TopCat C(·, ·) ContinuousMap.id ContinuousMap.comp +mk_concrete_category TopCat.{u} C(·, ·) ContinuousMap.id ContinuousMap.comp with_of_hom {X Y : Type u} [TopologicalSpace X] [TopologicalSpace Y] hom_type C(X, Y) from (TopCat.of X) to (TopCat.of Y) diff --git a/Mathlib/Topology/Category/UniformSpace.lean b/Mathlib/Topology/Category/UniformSpace.lean index 9bff8b745eceb7..4c1e671e933031 100644 --- a/Mathlib/Topology/Category/UniformSpace.lean +++ b/Mathlib/Topology/Category/UniformSpace.lean @@ -47,7 +47,7 @@ instance instFunLike (X Y : UniformSpaceCat) : coe := Subtype.val coe_injective' _ _ h := Subtype.ext h -mk_concrete_category UniformSpaceCat ({ f : · → · // UniformContinuous f }) +mk_concrete_category UniformSpaceCat.{u} ({ f : · → · // UniformContinuous f }) (fun _ ↦ ⟨id, uniformContinuous_id⟩) (fun g f ↦ ⟨g ∘ f, g.property.comp f.property⟩) with_of_hom {X Y : Type u} [UniformSpace X] [UniformSpace Y] hom_type { f : X → Y // UniformContinuous f } from (of X) to (of Y) From aa0f9ca26541c6061b0e2e97c03163223cba78b4 Mon Sep 17 00:00:00 2001 From: Dagur Asgeirsson Date: Wed, 6 May 2026 15:00:47 -0600 Subject: [PATCH 34/34] update docstring --- Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean index 6d8813efe7013a..cbb860c5b7b87e 100644 --- a/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean +++ b/Mathlib/Tactic/CategoryTheory/MkConcreteCategory.lean @@ -84,7 +84,7 @@ instance : CoeSort (ModuleTestCat.{v} R) (Type v) := attribute [coe] ModuleTestCat.carrier variable {R} in -mk_concrete_category (ModuleTestCat R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp +mk_concrete_category (ModuleTestCat.{v} R) (· →ₗ[R] ·) (@LinearMap.id R ·) LinearMap.comp with_of_hom {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y] [Module R Y] hom_type (X →ₗ[R] Y) from (of R X) to (of R Y) ``` @@ -133,10 +133,10 @@ end MultiplicativeTestCat attribute [coe] AdditiveTestCat.carrier MultiplicativeTestCat.carrier @[to_additive AdditiveTestCat] -mk_concrete_category MultiplicativeTestCat (· →* ·) MonoidHom.id MonoidHom.comp +mk_concrete_category MultiplicativeTestCat.{u} (· →* ·) MonoidHom.id MonoidHom.comp with_of_hom {X Y : Type u} [Monoid X] [Monoid Y] hom_type (X →* Y) from (MultiplicativeTestCat.of X) to (MultiplicativeTestCat.of Y) - to_additive AdditiveTestCat (· →+ ·) AddMonoidHom.id AddMonoidHom.comp + to_additive AdditiveTestCat.{u} (· →+ ·) AddMonoidHom.id AddMonoidHom.comp with_of_hom {X Y : Type u} [AddMonoid X] [AddMonoid Y] hom_type (X →+ Y) from (AdditiveTestCat.of X) to (AdditiveTestCat.of Y) ```