max/lean4-htt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 2

fix: make first token detection work in modules (#12047)

Browse source 
This PR makes the automatic first token detection in tactic docs much
more robust, in addition to making it work in modules and other contexts
where builtin tactics are not in the environment. It also adds the
ability to override the tactic's first token as the user-visible name.

Previously, first token detection would look up the parser descriptor in
the environment and process its syntax. This would be incorrect for
builtin parsers, as well as for modules in which the definition is not
loaded. Now, it instead consults the Pratt parsing table for the
`tactic` syntax category. Tests are added that ensure this keeps working
in modules, and also that the first token of all tactics that ship with
Lean are either detected unambiguously or annotated to remove ambiguity.

Closes #12038.
This commit is contained in:
David Thrane Christiansen 2026-01-20 12:12:05 +01:00 • committed by GitHub
parent db30cf3954
commit 9fbbe6554d
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
14 changed files with 739 additions and 638 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
src/Init/Tactics.lean
View file

@ -518,14 +518,13 @@ syntax location := withPosition(ppGroup(" at" (locationWildcard <|> locationHyp)
assuming these are definitionally equal.
* `change t' at h` will change hypothesis `h : t` to have type `t'`, assuming
assuming `t` and `t'` are definitionally equal.
-/
syntax (name := change) "change " term (location)? : tactic
/--
* `change a with b` will change occurrences of `a` to `b` in the goal,
assuming `a` and `b` are definitionally equal.
* `change a with b at h` similarly changes `a` to `b` in the type of hypothesis `h`.
-/
syntax (name := change) "change " term (location)? : tactic
@[tactic_alt change]
syntax (name := changeWith) "change " term " with " term (location)? : tactic
/--
@ -905,8 +904,13 @@ The tactic supports all the same syntax variants and options as the `let` term.
-/
macro "let" c:letConfig d:letDecl : tactic => `(tactic| refine_lift let $c:letConfig $d:letDecl; ?_)
/-- `let rec f : t := e` adds a recursive definition `f` to the current goal.
The syntax is the same as term-mode `let rec`. -/
/--
`let rec f : t := e` adds a recursive definition `f` to the current goal.
The syntax is the same as term-mode `let rec`.
The tactic supports all the same syntax variants and options as the `let` term.
-/
-- Uncomment after stage0 update: @[tactic_name "let rec"]
syntax (name := letrec) withPosition(atomic("let " &"rec ") letRecDecls) : tactic
macro_rules
| `(tactic| let rec $d) => `(tactic| refine_lift let rec $d; ?_)
@ -1212,22 +1216,6 @@ while `congr 2` produces the intended `⊢ x + y = y + x`.
syntax (name := congr) "congr" (ppSpace num)? : tactic
/--
In tactic mode, `if h : t then tac1 else tac2` can be used as alternative syntax for:
```
by_cases h : t
· tac1
· tac2
```
It performs case distinction on `h : t` or `h : ¬t` and `tac1` and `tac2` are the subproofs.
You can use `?_` or `_` for either subproof to delay the goal to after the tactic, but
if a tactic sequence is provided for `tac1` or `tac2` then it will require the goal to be closed
by the end of the block.
-/
syntax (name := tacDepIfThenElse)
ppRealGroup(ppRealFill(ppIndent("if " binderIdent " : " term " then") ppSpace matchRhsTacticSeq)
ppDedent(ppSpace) ppRealFill("else " matchRhsTacticSeq)) : tactic
/--
In tactic mode, `if t then tac1 else tac2` is alternative syntax for:
@ -1236,16 +1224,34 @@ by_cases t
· tac1
· tac2
```
It performs case distinction on `h† : t` or `h† : ¬t`, where `h†` is an anonymous
hypothesis, and `tac1` and `tac2` are the subproofs. (It doesn't actually use
nondependent `if`, since this wouldn't add anything to the context and hence would be
useless for proving theorems. To actually insert an `ite` application use
`refine if t then ?_ else ?_`.)
It performs case distinction on `h† : t` or `h† : ¬t`, where `h†` is an anonymous hypothesis, and
`tac1` and `tac2` are the subproofs. (It doesn't actually use nondependent `if`, since this wouldn't
add anything to the context and hence would be useless for proving theorems. To actually insert an
`ite` application use `refine if t then ?_ else ?_`.)
The assumptions in each subgoal can be named. `if h : t then tac1 else tac2` can be used as
alternative syntax for:
```
by_cases h : t
· tac1
· tac2
```
It performs case distinction on `h : t` or `h : ¬t`.
You can use `?_` or `_` for either subproof to delay the goal to after the tactic, but
if a tactic sequence is provided for `tac1` or `tac2` then it will require the goal to be closed
by the end of the block.
-/
syntax (name := tacIfThenElse)
ppRealGroup(ppRealFill(ppIndent("if " term " then") ppSpace matchRhsTacticSeq)
ppDedent(ppSpace) ppRealFill("else " matchRhsTacticSeq)) : tactic
@[tactic_alt tacIfThenElse]
syntax (name := tacDepIfThenElse)
ppRealGroup(ppRealFill(ppIndent("if " binderIdent " : " term " then") ppSpace matchRhsTacticSeq)
ppDedent(ppSpace) ppRealFill("else " matchRhsTacticSeq)) : tactic
/--
The tactic `nofun` is shorthand for `exact nofun`: it introduces the assumptions, then performs an
empty pattern match, closing the goal if the introduced pattern is impossible.

103
src/Lean/Elab/Tactic/Doc.lean
View file

@ -8,6 +8,7 @@ module
prelude
import Lean.DocString
public import Lean.Elab.Command
public import Lean.Parser.Tactic.Doc
public section
@ -38,30 +39,42 @@ open Lean.Parser.Command
| _ => throwError "Malformed 'register_tactic_tag' command"
/--
Gets the first string token in a parser description. For example, for a declaration like
`syntax "squish " term " with " term : tactic`, it returns `some "squish "`, and for a declaration
like `syntax tactic " <;;;> " tactic : tactic`, it returns `some " <;;;> "`.
Returns `none` for syntax declarations that don't contain a string constant.
Computes a table that heuristically maps parser syntax kinds to their first tokens by inspecting the
Pratt parsing tables for the `tactic syntax kind. If a custom name is provided for the tactic, then
it is returned instead.
-/
private partial def getFirstTk (e : Expr) : MetaM (Option String) := do
match (← Meta.whnf e).getAppFnArgs with
| (``ParserDescr.node, #[_, _, p]) => getFirstTk p
| (``ParserDescr.trailingNode, #[_, _, _, p]) => getFirstTk p
| (``ParserDescr.unary, #[.app _ (.lit (.strVal "withPosition")), p]) => getFirstTk p
| (``ParserDescr.unary, #[.app _ (.lit (.strVal "atomic")), p]) => getFirstTk p
| (``ParserDescr.binary, #[.app _ (.lit (.strVal "andthen")), p, _]) => getFirstTk p
| (``ParserDescr.nonReservedSymbol, #[.lit (.strVal tk), _]) => pure (some tk)
| (``ParserDescr.symbol, #[.lit (.strVal tk)]) => pure (some tk)
| (``Parser.withAntiquot, #[_, p]) => getFirstTk p
| (``Parser.leadingNode, #[_, _, p]) => getFirstTk p
| (``HAndThen.hAndThen, #[_, _, _, _, p1, p2]) =>
if let some tk ← getFirstTk p1 then pure (some tk)
else getFirstTk (.app p2 (.const ``Unit.unit []))
| (``Parser.nonReservedSymbol, #[.lit (.strVal tk), _]) => pure (some tk)
| (``Parser.symbol, #[.lit (.strVal tk)]) => pure (some tk)
| _ => pure none
def firstTacticTokens [Monad m] [MonadEnv m] : m (NameMap String) := do
let env ← getEnv
let some tactics := (Lean.Parser.parserExtension.getState env).categories.find? `tactic
| return {}
let mut firstTokens : NameMap String :=
tacticNameExt.toEnvExtension.getState env
|>.importedEntries
|>.push (tacticNameExt.exportEntriesFn env (tacticNameExt.getState env) .exported)
|>.foldl (init := {}) fun names inMods =>
inMods.foldl (init := names) fun names (k, n) =>
names.insert k n
firstTokens := addFirstTokens tactics tactics.tables.leadingTable firstTokens
firstTokens := addFirstTokens tactics tactics.tables.trailingTable firstTokens
return firstTokens
where
addFirstTokens tactics table firsts : NameMap String := Id.run do
let mut firsts := firsts
for (tok, ps) in table do
-- Skip antiquotes
if tok == `«$» then continue
for (p, _) in ps do
for (k, ()) in p.info.collectKinds {} do
if tactics.kinds.contains k then
let tok := tok.toString (escape := false)
-- It's important here that the already-existing mapping is preserved, because it will
-- contain any user-provided custom name, and these shouldn't be overridden.
firsts := firsts.alter k (·.getD tok)
return firsts
/--
Creates some `MessageData` for a parser name.
@ -71,18 +84,14 @@ identifiable leading token, then that token is shown. Otherwise, the underlying
without an `@`. The name includes metadata that makes infoview hovers and the like work. This
only works for global constants, as the local context is not included.
-/
private def showParserName (n : Name) : MetaM MessageData := do
private def showParserName [Monad m] [MonadEnv m] (firsts : NameMap String) (n : Name) : m MessageData := do
let env ← getEnv
let params :=
env.constants.find?' n |>.map (·.levelParams.map Level.param) |>.getD []
let tok ←
if let some descr := env.find? n |>.bind (·.value?) then
if let some tk ← getFirstTk descr then
pure <| Std.Format.text tk.trimAscii.copy
else pure <| format n
else pure <| format n
let tok := ((← customTacticName n) <|> firsts.get? n).map Std.Format.text |>.getD (format n)
pure <| .ofFormatWithInfos {
fmt := "'" ++ .tag 0 tok ++ "'",
fmt := "`" ++ .tag 0 tok ++ "`",
infos :=
.ofList [(0, .ofTermInfo {
lctx := .empty,
@ -93,7 +102,6 @@ private def showParserName (n : Name) : MetaM MessageData := do
})] _
}
/--
Displays all available tactic tags, with documentation.
-/
@ -106,20 +114,22 @@ Displays all available tactic tags, with documentation.
for (tac, tag) in arr do
mapping := mapping.insert tag (mapping.getD tag {} |>.insert tac)
let firsts ← firstTacticTokens
let showDocs : Option String → MessageData
| none => .nil
| some d => Format.line ++ MessageData.joinSep ((d.split '\n').map (toMessageData ∘ String.Slice.copy)).toList Format.line
let showTactics (tag : Name) : MetaM MessageData := do
let showTactics (tag : Name) : CommandElabM MessageData := do
match mapping.find? tag with
| none => pure .nil
| some tacs =>
if tacs.isEmpty then pure .nil
else
let tacs := tacs.toArray.qsort (·.toString < ·.toString) |>.toList
pure (Format.line ++ MessageData.joinSep (← tacs.mapM showParserName) ", ")
pure (Format.line ++ MessageData.joinSep (← tacs.mapM (showParserName firsts)) ", ")
let tagDescrs ← liftTermElabM <| (← allTagsWithInfo).mapM fun (name, userName, docs) => do
let tagDescrs ← (← allTagsWithInfo).mapM fun (name, userName, docs) => do
pure <| m!"• " ++
MessageData.nestD (m!"`{name}`" ++
(if name.toString != userName then m!" — \"{userName}\"" else MessageData.nil) ++
@ -146,13 +156,13 @@ structure TacticDoc where
/-- Any docstring extensions that have been specified -/
extensionDocs : Array String
def allTacticDocs : MetaM (Array TacticDoc) := do
def allTacticDocs (includeUnnamed : Bool := true) : MetaM (Array TacticDoc) := do
let env ← getEnv
let all :=
tacticTagExt.toEnvExtension.getState (← getEnv)
|>.importedEntries |>.push (tacticTagExt.exportEntriesFn (← getEnv) (tacticTagExt.getState (← getEnv)) .exported)
let allTags :=
tacticTagExt.toEnvExtension.getState env |>.importedEntries
|>.push (tacticTagExt.exportEntriesFn env (tacticTagExt.getState env) .exported)
let mut tacTags : NameMap NameSet := {}
for arr in all do
for arr in allTags do
for (tac, tag) in arr do
tacTags := tacTags.insert tac (tacTags.getD tac {} |>.insert tag)
@ -160,15 +170,18 @@ def allTacticDocs : MetaM (Array TacticDoc) := do
let some tactics := (Lean.Parser.parserExtension.getState env).categories.find? `tactic
| return #[]
let firstTokens ← firstTacticTokens
for (tac, _) in tactics.kinds do
-- Skip noncanonical tactics
if let some _ := alternativeOfTactic env tac then continue
let userName : String ←
if let some descr := env.find? tac |>.bind (·.value?) then
if let some tk ← getFirstTk descr then
pure tk.trimAscii.copy
else pure tac.toString
else pure tac.toString
let userName? : Option String := firstTokens.get? tac
let userName ←
if let some n := userName? then pure n
else if includeUnnamed then pure tac.toString
else continue
docs := docs.push {
internalName := tac,

17
src/Lean/Parser/Attr.lean
View file

@ -54,7 +54,7 @@ def externEntry := leading_parser
nonReservedSymbol "extern" >> many (ppSpace >> externEntry)
/--
Declare this tactic to be an alias or alternative form of an existing tactic.
Declares this tactic to be an alias or alternative form of an existing tactic.
This has the following effects:
* The alias relationship is saved
@ -64,13 +64,26 @@ This has the following effects:
"tactic_alt" >> ppSpace >> ident
/--
Add one or more tags to a tactic.
Adds one or more tags to a tactic.
Tags should be applied to the canonical names for tactics.
-/
@[builtin_attr_parser] def «tactic_tag» := leading_parser
"tactic_tag" >> many1 (ppSpace >> ident)
/--
Sets the tactic's name.
Ordinarily, tactic names are automatically set to the first token in the tactic's parser. If this
process fails, or if the tactic's name should be multiple tokens (e.g. `let rec`), then this
attribute can be used to provide a name.
The tactic's name is used in documentation as well as in completion. Thus, the name should be a
valid prefix of the tactic's syntax.
-/
@[builtin_attr_parser] def «tactic_name» := leading_parser
"tactic_name" >> ppSpace >> (ident <|> strLit)
end Attr
end Lean.Parser

19
src/Lean/Parser/Tactic.lean
View file

@ -52,24 +52,7 @@ example (n : Nat) : n = n := by
optional Term.motive >> sepBy1 Term.matchDiscr ", " >>
" with " >> ppDedent matchAlts
/--
The tactic
```
intro
| pat1 => tac1
| pat2 => tac2
```
is the same as:
```
intro x
match x with
| pat1 => tac1
| pat2 => tac2
```
That is, `intro` can be followed by match arms and it introduces the values while
doing a pattern match. This is equivalent to `fun` with match arms in term mode.
-/
@[builtin_tactic_parser] def introMatch := leading_parser
@[builtin_tactic_parser, tactic_alt intro] def introMatch := leading_parser
nonReservedSymbol "intro" >> matchAlts
builtin_initialize

78
src/Lean/Parser/Tactic/Doc.lean
View file

@ -191,12 +191,13 @@ builtin_initialize
unless kind == AttributeKind.global do throwAttrMustBeGlobal name kind
let `(«tactic_tag»|tactic_tag $tags*) := stx
| throwError "Invalid `[{name}]` attribute syntax"
if (← getEnv).find? decl |>.isSome then
if !(isTactic (← getEnv) decl) then
throwErrorAt stx "`{decl}` is not a tactic"
throwErrorAt stx "`{.ofConstName decl}` is not a tactic"
if let some tgt' := alternativeOfTactic (← getEnv) decl then
throwErrorAt stx "`{decl}` is an alternative form of `{tgt'}`"
throwErrorAt stx "`{.ofConstName decl}` is an alternative form of `{.ofConstName tgt'}`"
for t in tags do
let tagName := t.getId
@ -271,14 +272,81 @@ where
| [l] => " * " ++ l ++ "\n\n"
| l::ls => " * " ++ l ++ "\n" ++ String.join (ls.map indentLine) ++ "\n\n"
/--
The mapping between tactics and their custom names.
The first projection in each pair is the tactic name, and the second is the custom name.
-/
builtin_initialize tacticNameExt
: PersistentEnvExtension
(Name × String)
(Name × String)
(NameMap String) ←
registerPersistentEnvExtension {
mkInitial := pure {},
addImportedFn := fun _ => pure {},
addEntryFn := fun as (src, tgt) => as.insert src tgt,
exportEntriesFn := fun es =>
es.foldl (fun a src tgt => a.push (src, tgt)) #[] |>.qsort (Name.quickLt ·.1 ·.1)
}
/--
Finds the custom name assigned to `tac`, or returns `none` if there is no such custom name.
-/
def customTacticName [Monad m] [MonadEnv m] (tac : Name) : m (Option String) := do
let env ← getEnv
match env.getModuleIdxFor? tac with
| some modIdx =>
match (tacticNameExt.getModuleEntries env modIdx).binSearch (tac, default) (Name.quickLt ·.1 ·.1) with
| some (_, val) => return some val
| none => return none
| none => return tacticNameExt.getState env |>.find? tac
builtin_initialize
let name := `tactic_name
registerBuiltinAttribute {
name := name,
ref := by exact decl_name%,
add := fun decl stx kind => do
unless kind == AttributeKind.global do throwAttrMustBeGlobal name kind
let name ←
match stx with
| `(«tactic_name»|tactic_name $name:str) =>
pure name.getString
| `(«tactic_name»|tactic_name $name:ident) =>
pure (name.getId.toString (escape := false))
| _ => throwError "Invalid `[{name}]` attribute syntax"
if (← getEnv).find? decl |>.isSome then
if !(isTactic (← getEnv) decl) then
throwErrorAt stx m!"`{.ofConstName decl}` is not a tactic"
if let some idx := (← getEnv).getModuleIdxFor? decl then
if let some mod := (← getEnv).allImportedModuleNames[idx]? then
throwErrorAt stx m!"`{.ofConstName decl}` is defined in `{mod}`, but custom names can only be added in the tactic's defining module."
else
throwErrorAt stx m!"`{.ofConstName decl}` is defined in an imported module, but custom names can only be added in the tactic's defining module."
if let some tgt' := alternativeOfTactic (← getEnv) decl then
throwErrorAt stx "`{.ofConstName decl}` is an alternative form of `{.ofConstName tgt'}`"
if let some n ← customTacticName decl then
throwError m!"The tactic `{.ofConstName decl}` already has the custom name `{n}`"
modifyEnv fun env => tacticNameExt.addEntry env (decl, name)
descr :=
"Registers a custom name for a tactic. This custom name should be a prefix of the " ++
"tactic's syntax, because it is used in completion.",
applicationTime := .beforeElaboration
}
-- Note: this error handler doesn't prevent all cases of non-tactics being added to the data
-- structure. But the module will throw errors during elaboration, and there doesn't seem to be
-- another way to implement this, because the category parser extension attribute runs *after* the
-- attributes specified before a `syntax` command.
/--
Validates that a tactic alternative is actually a tactic and that syntax tagged as tactics are
tactics.
Validates that a tactic alternative is actually a tactic, that syntax tagged as tactics are
tactics, and that syntax with tactic names are tactics.
-/
private def tacticDocsOnTactics : ParserAttributeHook where
postAdd (catName declName : Name) (_builtIn : Bool) := do
@ -291,6 +359,8 @@ private def tacticDocsOnTactics : ParserAttributeHook where
if let some tags := tacticTagExt.getState (← getEnv) |>.find? declName then
if !tags.isEmpty then
throwError m!"`{.ofConstName declName}` is not a tactic"
if let some n := tacticNameExt.getState (← getEnv) |>.find? declName then
throwError m!"`{MessageData.ofConstName declName}` is not a tactic, but it was assigned a tactic name `{n}`"
builtin_initialize
registerParserAttributeHook tacticDocsOnTactics

3
src/Lean/Server/Completion/CompletionCollectors.lean
View file

@ -597,7 +597,8 @@ def tacticCompletion
(completionInfoPos : Nat)
(ctx : ContextInfo)
: IO (Array ResolvableCompletionItem) := ctx.runMetaM .empty do
let allTacticDocs ← Tactic.Doc.allTacticDocs
-- Don't include tactics that are identified only by their internal parser name
let allTacticDocs ← Tactic.Doc.allTacticDocs (includeUnnamed := false)
let items : Array ResolvableCompletionItem := allTacticDocs.map fun tacticDoc => {
label := tacticDoc.userName
detail? := none

1
src/Std/Tactic/Do/Syntax.lean
View file

@ -290,6 +290,7 @@ syntax "∀" binderIdent : mintroPat
@[tactic_alt Lean.Parser.Tactic.mintroMacro]
syntax (name := mintro) "mintro" (ppSpace colGt mintroPat)+ : tactic
@[tactic_alt Lean.Parser.Tactic.mintroMacro]
macro (name := mintroError) "mintro" : tactic => Macro.throwError "`mintro` expects at least one pattern"
macro_rules

1
stage0/src/stdlib_flags.h
View file

@ -1,5 +1,6 @@
#include "util/options.h"
// Dear CI, please update stage0
namespace lean {
options get_default_options() {
options opts;

14
tests/lean/interactive/completionTactics.lean
View file

@ -118,3 +118,17 @@ example : True := by
{ skip -- All tactic completions expected
}
--^ completion
/-!
Now check that first token detection and tactic names work correctly in completion.
-/
/-- Local def -/
syntax "let " letDecl : tactic
/-- Local recursive def -/
@[tactic_name "let rec"]
syntax (name := letrec) "let " &"rec" letRecDecls : tactic
example : True := by
--^ completion

905
tests/lean/interactive/completionTactics.lean.expected.out
View file

File diff suppressed because it is too large Load diff

67
tests/lean/run/tacticDoc.lean
View file

@ -128,17 +128,78 @@ Note: This linter can be disabled with `set_option linter.tactic.docsOnAlt false
attribute [tactic_alt my_trivial] «yetAnother»
/-! # Querying Tactic Docs -/
/-!
`tm` is part of the below set because the tag attribute can't reject `someTerm` above before it is
added. Because it's not a tactic, its first token is not found.
-/
/--
info: Available tags: ⏎
• `ctrl` — "control flow"
Tactics that sequence or arrange other tactics ⏎
'<;>'
`<;>`
• `extensible`
Tactics that are intended to be extensible ⏎
'my_trivial'
`my_trivial`
• `finishing`
Finishing tactics that are intended to completely close a goal ⏎
'omega', 'my_trivial', 'someTerm'
`omega`, `my_trivial`, `tm`
-/
#guard_msgs in
#print tactic tags
/-!
## Custom Names
The next two tests check that custom tactic names are shown.
-/
@[tactic_tag finishing]
syntax (name := fooBar) "foo" "bar" term : tactic
/-!
Here, the first token `foo` is shown:
-/
/--
info: Available tags: ⏎
• `ctrl` — "control flow"
Tactics that sequence or arrange other tactics ⏎
`<;>`
• `extensible`
Tactics that are intended to be extensible ⏎
`my_trivial`
• `finishing`
Finishing tactics that are intended to completely close a goal ⏎
`omega`, `foo`, `my_trivial`, `tm`
-/
#guard_msgs in
#print tactic tags
attribute [tactic_name "foo bar"] fooBar
/-!
Now we show `foo bar`:
-/
/--
info: Available tags: ⏎
• `ctrl` — "control flow"
Tactics that sequence or arrange other tactics ⏎
`<;>`
• `extensible`
Tactics that are intended to be extensible ⏎
`my_trivial`
• `finishing`
Finishing tactics that are intended to completely close a goal ⏎
`omega`, `foo bar`, `my_trivial`, `tm`
-/
#guard_msgs in
#print tactic tags
/-!
This test checks that tactic names can't be added to other kinds of syntax.
-/
/-- error: `termNotATactic` is not a tactic, but it was assigned a tactic name `t` -/
#guard_msgs in
@[tactic_name t]
syntax "not " "a " "tactic" : term

25
tests/lean/run/tacticDocAllModule.lean Normal file
View file

@ -0,0 +1,25 @@
module
import Lean.Elab.Tactic.Doc
/-!
This test checks that the first tokens are found for the tactics that ship with Lean when in a
module.
In the past, the first token detection code attempted to process the descriptor in the environment;
this failed in modules because the parser was not loaded. This test, along with tacticDocAllNonmod,
check that the code works correctly both in and out of modules.
-/
open Lean.Elab.Tactic.Doc
#guard_msgs in
open Lean in
#eval do
let docs ← allTacticDocs
let userNames := docs.map TacticDoc.userName
if userNames.size < 50 then
throwError "Implausibly few user names found: {userNames}"
for n in userNames do
if n.startsWith "Lean.Parser.Tactic" && n ≠ "Lean.Parser.Tactic.nestedTactic" then
logError "Didn't find a first token for tactic parser {n}"

23
tests/lean/run/tacticDocAllNonmod.lean Normal file
View file

@ -0,0 +1,23 @@
import Lean.Elab.Tactic.Doc
/-!
This test checks that the first tokens are found for the tactics that ship with Lean when not in a
module.
In the past, the first token detection code attempted to process the descriptor in the environment;
this failed in modules because the parser was not loaded. This test, along with tacticDocAllModule,
check that the code works correctly both in and out of modules.
-/
open Lean.Elab.Tactic.Doc
#guard_msgs in
open Lean in
#eval do
let docs ← allTacticDocs
let userNames := docs.map TacticDoc.userName
if userNames.size < 50 then
throwError "Implausibly few user names found: {userNames}"
for n in userNames do
if n.startsWith "Lean.Parser.Tactic" && n ≠ "Lean.Parser.Tactic.nestedTactic" then
logError "Didn't find a first token for tactic parser {n}"

61
tests/lean/run/tacticDocUserName.lean Normal file
View file

@ -0,0 +1,61 @@
import Lean
open Lean Elab Tactic Doc
/-!
This test ensures that user-facing tactic names shipped with Lean are kept unambiguous.
-/
#eval show MetaM Unit from do
let firsts ← firstTacticTokens
-- Compute a reverse mapping from first tokens to their syntax kinds
let mut rev : Std.HashMap String (List Name) := {}
for (k, firstTok) in firsts do
rev := rev.alter firstTok fun x? => x?.map (k :: ·) |>.getD [k]
-- Check each for ambiguity
for (firstTok, kindsForToken) in rev do
-- Skip kinds that are alternative syntax for some user-facing parser
let kindsForToken ← kindsForToken.filterM fun k => do
pure <| (Parser.Tactic.Doc.alternativeOfTactic (← getEnv) k).isNone
-- Until a stage0 update allows let rec to have a custom name, ignore it. Then update this test.
let kindsForToken := kindsForToken.filter (· ≠ ``Lean.Parser.Tactic.letrec)
if firstTok.contains ' ' then throwError "Test needs updating after stage0 update (see comment)"
-- If it's ambiguous, log an error.
if kindsForToken.length > 1 then
let kinds := MessageData.andList <| kindsForToken.map (m!"`{.ofConstName ·}`")
logError m!"`{firstTok}` is the ambiguous first token for {kinds}"
/-!
This test ensures that user-facing tactic names are found for all the tactics that we ship.
-/
#eval show MetaM Unit from do
let firsts ← firstTacticTokens
let some tactics := (Lean.Parser.parserExtension.getState (← getEnv)).categories.find? `tactic
| return
for (t, ()) in tactics.kinds do
if t == ``Lean.Parser.Tactic.nestedTactic then continue
unless firsts.contains t do
logError m!"Couldn't find the first token for tactic syntax kind {t}"
/-!
This test spot-checks tactics defined in a few ways to make sure they all have user-facing names:
* Defined using `syntax ... : tactic`, both leading and trailing (`intros` and `<;>`)
* Defined using `declare_simp_like_tactic` (`simpAutoUnfold`)
* Defined with custom user-facing names (`Lean.Parser.Tactic.letrec`) (after stage0 update)
-/
/--
info: (some intro)
(some <;>)
(some simp!)
-/
#guard_msgs in
#eval show MetaM Unit from do
let firsts ← firstTacticTokens
IO.println (firsts.get? ``Lean.Parser.Tactic.intro)
IO.println (firsts.get? ``Lean.Parser.Tactic.«tactic_<;>_»)
IO.println (firsts.get? ``Lean.Parser.Tactic.simpAutoUnfold)
--IO.println (firsts.get? ``Lean.Parser.Tactic.letrec)