diff --git a/Mathlib/CategoryTheory/Monoidal/Mod.lean b/Mathlib/CategoryTheory/Monoidal/Mod.lean index a23ee55949bdd7..489ce4838ba764 100644 --- a/Mathlib/CategoryTheory/Monoidal/Mod.lean +++ b/Mathlib/CategoryTheory/Monoidal/Mod.lean @@ -147,9 +147,6 @@ alias IsMod_Hom.smul_hom := IsModHom.smul_hom attribute [to_additive existing (attr := reassoc (attr := simp))] IsModHom.smul_hom -set_option linter.existingAttributeWarning false in -attribute [to_additive existing] IsModHom.smul_hom_assoc - variable {M N O : D} [ModObj A M] [ModObj A N] [ModObj A O] @[to_additive] diff --git a/Mathlib/CategoryTheory/Monoidal/Mon.lean b/Mathlib/CategoryTheory/Monoidal/Mon.lean index 74e4bf81177b95..820de350ddf7c0 100644 --- a/Mathlib/CategoryTheory/Monoidal/Mon.lean +++ b/Mathlib/CategoryTheory/Monoidal/Mon.lean @@ -105,8 +105,6 @@ variable {M X Y : C} [MonObj M] attribute [reassoc (attr := simp)] one_mul mul_one mul_assoc attribute [reassoc (attr := simp)] AddMonObj.zero_add AddMonObj.add_zero AddMonObj.add_assoc -set_option linter.existingAttributeWarning false in -attribute [to_additive existing] one_mul_assoc mul_one_assoc mul_assoc_assoc /-- Transfer `MonObj` along an isomorphism. -/ -- Note: The simps lemmas are not tagged simp because their `#discr_tree_simp_key` are too generic. diff --git a/Mathlib/Tactic/CategoryTheory/Reassoc.lean b/Mathlib/Tactic/CategoryTheory/Reassoc.lean index f579e167770c6c..bb65495f6e2dcb 100644 --- a/Mathlib/Tactic/CategoryTheory/Reassoc.lean +++ b/Mathlib/Tactic/CategoryTheory/Reassoc.lean @@ -138,14 +138,11 @@ def reassocExpr' (pf : Expr) : TermElabM Expr := do Term.registerSyntheticMVarWithCurrRef inst (.typeClass none) return e -initialize registerBuiltinAttribute { - name := `reassoc - descr := "" - applicationTime := .afterCompilation - add := fun src ref kind => match ref with +private def reassocImpl (src : Name) (ref : Syntax) (kind : AttributeKind) : AttrM Name := + match ref with | `(attr| reassoc $[$toDual:toDualOpt]? $optAttr) => MetaM.run' do - if (kind != AttributeKind.global) then - throwError "`reassoc` can only be used as a global attribute" + unless kind == AttributeKind.global do + throwAttrMustBeGlobal `reassoc kind let toDual := toDual.isSome || (Translate.findTranslation? (← getEnv) ToDual.data src).isSome let tgt := src.appendAfter "_assoc" addRelatedDecl src tgt ref optAttr fun value levels => do @@ -157,7 +154,17 @@ initialize registerBuiltinAttribute { if toDual then liftCommandElabM <| Command.elabCommand <| ← `(command| attribute [to_dual none] $(mkIdent tgt)) - | _ => throwUnsupportedSyntax } + return tgt + | _ => throwUnsupportedSyntax + +initialize + registerGeneratingAttr `reassoc ((#[·]) <$> reassocImpl · · ·) + registerBuiltinAttribute { + name := `reassoc + descr := "" + applicationTime := .afterCompilation + add := (discard <| reassocImpl · · ·) + } /-- `reassoc_of% t`, where `t` is diff --git a/Mathlib/Tactic/Translate/Core.lean b/Mathlib/Tactic/Translate/Core.lean index 5857d6b7916a1d..e493c6bb6bbcd4 100644 --- a/Mathlib/Tactic/Translate/Core.lean +++ b/Mathlib/Tactic/Translate/Core.lean @@ -881,9 +881,9 @@ def warnParametricAttr {β : Type} [Inhabited β] (stx : Syntax) (attr : Paramet /-- `translateLemmas names argInfo desc t` runs `t` on all elements of `names` and adds translations between the generated lemmas (the output of `t`). `names` must be non-empty. -/ -def translateLemmas {m : Type → Type} [Monad m] [MonadError m] [MonadLiftT CoreM m] +def translateLemmas (t : TranslateData) (names : Array Name) (reorder : Reorder) (relevantArg : RelevantArg) - (desc : String) (ref : Syntax) (runAttr : Name → m (Array Name)) : m Unit := do + (desc : String) (ref : Syntax) (runAttr : Name → CoreM (Array Name)) : CoreM Unit := do let auxLemmas ← names.mapM runAttr let nLemmas := auxLemmas[0]!.size for nm in names, lemmas in auxLemmas do @@ -891,7 +891,10 @@ def translateLemmas {m : Type → Type} [Monad m] [MonadError m] [MonadLiftT Cor throwError "{names[0]!} and {nm} do not generate the same number of {desc}." for srcLemmas in auxLemmas, tgtLemmas in auxLemmas.eraseIdx! 0 do for srcLemma in srcLemmas, tgtLemma in tgtLemmas do - insertTranslation t srcLemma tgtLemma reorder relevantArg ref + -- Only add a translation if one doesn't already exist. + -- This happens if `srcLemma` is the `_assoc` lemma from `to_dual (attr := reassoc)`. + if (findTranslation? (← getEnv) t srcLemma).isNone then + insertTranslation t srcLemma tgtLemma reorder relevantArg ref /-- Return the provided target name or autogenerate one if one was not provided. -/ def targetName (t : TranslateData) (cfg : Config) (src : Name) : CoreM Name := do