refactor: add numFixed to Structural.EqnInfo (#4788)

This commit is contained in:
Joachim Breitner 2024-07-19 12:21:43 +02:00 committed by GitHub
parent e32f3e8140
commit 204d4839fa
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 9 additions and 6 deletions

View file

@ -21,6 +21,7 @@ namespace Structural
structure EqnInfo extends EqnInfoCore where
recArgPos : Nat
declNames : Array Name
numFixed : Nat
deriving Inhabited
private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
@ -81,9 +82,11 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat) : CoreM Unit := do
def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat)
(numFixed : Nat) : CoreM Unit := do
ensureEqnReservedNamesAvailable preDef.declName
modifyEnv fun env => eqnInfoExt.insert env preDef.declName { preDef with recArgPos, declNames }
modifyEnv fun env => eqnInfoExt.insert env preDef.declName
{ preDef with recArgPos, declNames, numFixed }
def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
if let some info := eqnInfoExt.find? (← getEnv) declName then

View file

@ -128,7 +128,7 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
return (Array.zip preDefs valuesNew).map fun ⟨preDef, valueNew⟩ => { preDef with value := valueNew }
private def inferRecArgPos (preDefs : Array PreDefinition) (termArg?s : Array (Option TerminationArgument)) :
M (Array Nat × Array PreDefinition) := do
M (Array Nat × (Array PreDefinition) × Nat) := do
withoutModifyingEnv do
preDefs.forM (addAsAxiom ·)
let fnNames := preDefs.map (·.declName)
@ -154,7 +154,7 @@ private def inferRecArgPos (preDefs : Array PreDefinition) (termArg?s : Array (O
withErasedFVars (xs.extract numFixed xs.size |>.map (·.fvarId!)) do
let xs := xs[:numFixed]
let preDefs' ← elimMutualRecursion preDefs xs recArgInfos
return (recArgPoss, preDefs')
return (recArgPoss, preDefs', numFixed)
def reportTermArg (preDef : PreDefinition) (recArgPos : Nat) : MetaM Unit := do
if let some ref := preDef.termination.terminationBy?? then
@ -167,7 +167,7 @@ def reportTermArg (preDef : PreDefinition) (recArgPos : Nat) : MetaM Unit := do
def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Option TerminationArgument)) : TermElabM Unit := do
let names := preDefs.map (·.declName)
let ((recArgPoss, preDefsNonRec), state) ← run <| inferRecArgPos preDefs termArg?s
let ((recArgPoss, preDefsNonRec, numFixed), state) ← run <| inferRecArgPos preDefs termArg?s
for recArgPos in recArgPoss, preDef in preDefs do
reportTermArg preDef recArgPos
state.addMatchers.forM liftM
@ -190,7 +190,7 @@ def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Opti
for theorems and definitions that are propositions.
See issue #2327
-/
registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos
registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos numFixed
addSmartUnfoldingDef preDef recArgPos
markAsRecursive preDef.declName
applyAttributesOf preDefsNonRec AttributeApplicationTime.afterCompilation