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

feat: init_grind_norm elaborator (#6690)

Browse source 
Motivation: we will remove the `[grind_norm]` attribute.
This commit is contained in:
Leonardo de Moura 2025-01-18 16:15:13 -08:00 • committed by GitHub
parent 5998ba545b
commit 478d42105f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 23 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/Lean/Elab/Tactic/Grind.lean
View file

@ -34,6 +34,17 @@ def elabGrindPattern : CommandElab := fun stx => do
Grind.addEMatchTheorem declName xs.size patterns.toList
| _ => throwUnsupportedSyntax
open Command Term in
@[builtin_command_elab Lean.Parser.Command.initGrindNorm]
def elabInitGrindNorm : CommandElab := fun stx =>
match stx with
| `(init_grind_norm $pre:ident* | $post*) =>
Command.liftTermElabM do
let pre ← pre.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
let post ← post.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
Grind.registerNormTheorems pre post
| _ => throwUnsupportedSyntax
def elabGrindParams (params : Grind.Params) (ps : TSyntaxArray ``Parser.Tactic.grindParam) : MetaM Grind.Params := do
let mut params := params
for p in ps do
@ -104,7 +115,7 @@ private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit
pure auxDeclName
unsafe evalConst (Grind.GoalM Unit) auxDeclName
@[builtin_tactic Lean.Parser.Tactic.grind] def evalApplyRfl : Tactic := fun stx => do
@[builtin_tactic Lean.Parser.Tactic.grind] def evalGrind : Tactic := fun stx => do
match stx with
| `(tactic| grind $config:optConfig $[only%$only]? $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
let fallback ← elabFallback fallback?

11
src/Lean/Meta/Tactic/Grind/SimpUtil.lean
View file

@ -11,6 +11,17 @@ import Lean.Meta.Tactic.Simp.BuiltinSimprocs.List
namespace Lean.Meta.Grind
builtin_initialize normExt : SimpExtension ← mkSimpExt
def registerNormTheorems (preDeclNames : Array Name) (postDeclNames : Array Name) : MetaM Unit := do
let thms ← normExt.getTheorems
unless thms.lemmaNames.isEmpty do
throwError "`grind` normalization theorems have already been initialized"
for declName in preDeclNames do
addSimpTheorem normExt declName (post := false) (inv := false) .global (eval_prio default)
for declName in postDeclNames do
addSimpTheorem normExt declName (post := true) (inv := false) .global (eval_prio default)
/-- Returns the array of simprocs used by `grind`. -/
protected def getSimprocs : MetaM (Array Simprocs) := do
let s ← grindNormSimprocExt.getSimprocs