diff --git a/src/Lean/DocString.lean b/src/Lean/DocString.lean index fd6bb3ce9b..70d241e5a2 100644 --- a/src/Lean/DocString.lean +++ b/src/Lean/DocString.lean @@ -44,7 +44,7 @@ termination_by consumeSpaces n it r => (it, 1) saveLine it r => (it, 0) -private def removeLeadingSpaces (s : String) : String := +def removeLeadingSpaces (s : String) : String := let n := findLeadingSpacesSize s if n == 0 then s else removeNumLeadingSpaces n s @@ -92,4 +92,9 @@ def getDocStringText [Monad m] [MonadError m] [MonadRef m] (stx : TSyntax `Lean. | Syntax.atom _ val => return val.extract 0 (val.endPos - ⟨2⟩) | _ => throwErrorAt stx "unexpected doc string{indentD stx.raw[1]}" +def TSyntax.getDocString (stx : TSyntax `Lean.Parser.Command.docComment) : String := + match stx.raw[1] with + | Syntax.atom _ val => val.extract 0 (val.endPos - ⟨2⟩) + | _ => panic! s!"unexpected doc string\n{stx.raw[1]}" + end Lean diff --git a/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean b/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean index 8b523f8cf9..414b3cbd3b 100644 --- a/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean +++ b/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean @@ -9,6 +9,7 @@ import Lean.Meta.DiscrTree import Lean.Meta.AppBuilder import Lean.Meta.Eqns import Lean.Meta.Tactic.AuxLemma +import Lean.DocString namespace Lean.Meta /-- @@ -415,12 +416,13 @@ def SimpTheoremsArray.isErased (thmsArray : SimpTheoremsArray) (thmId : Name) : def SimpTheoremsArray.isDeclToUnfold (thmsArray : SimpTheoremsArray) (declName : Name) : Bool := thmsArray.any fun thms => thms.isDeclToUnfold declName -macro (name := _root_.Lean.Parser.Command.registerSimpAttr) doc?:(docComment)? - "register_simp_attr" id:ident descr:str : command => do +macro (name := _root_.Lean.Parser.Command.registerSimpAttr) doc:docComment + "register_simp_attr" id:ident : command => do let str := id.getId.toString let idParser := mkIdentFrom id (`Parser.Attr ++ id.getId) - `($[$doc?]? initialize ext : SimpExtension ← registerSimpAttr $(quote id.getId) $descr $(quote id.getId) - $[$doc?]? syntax (name := $idParser:ident) $(quote str):str (Parser.Tactic.simpPre <|> Parser.Tactic.simpPost)? (prio)? : attr) + let descr := quote (removeLeadingSpaces doc.getDocString) + `($doc:docComment initialize ext : SimpExtension ← registerSimpAttr $(quote id.getId) $descr $(quote id.getId) + $doc:docComment syntax (name := $idParser:ident) $(quote str):str (Parser.Tactic.simpPre <|> Parser.Tactic.simpPost)? (prio)? : attr) end Meta diff --git a/tests/lean/run/1374.lean b/tests/lean/run/1374.lean index a0c3b741c8..d8fafdfca6 100644 --- a/tests/lean/run/1374.lean +++ b/tests/lean/run/1374.lean @@ -13,7 +13,7 @@ register_builtin_option testb : Nat := { } /-- My new simp attribute -/ -register_simp_attr mysimp "my simp attr" +register_simp_attr mysimp /-- config elab -/ declare_config_elab elabSimpConfig' Lean.Meta.Simp.Config diff --git a/tests/pkg/user_attr/UserAttr/BlaAttr.lean b/tests/pkg/user_attr/UserAttr/BlaAttr.lean index efcaf85273..dd652db07b 100644 --- a/tests/pkg/user_attr/UserAttr/BlaAttr.lean +++ b/tests/pkg/user_attr/UserAttr/BlaAttr.lean @@ -4,8 +4,8 @@ open Lean initialize blaAttr : TagAttribute ← registerTagAttribute `bla "simple user defined attribute" -/-- My new simp attribute -/ -register_simp_attr my_simp "my own simp attribute" +/-- My own new simp attribute. -/ +register_simp_attr my_simp syntax (name := foo) "foo" num "important"? : attr