Compare commits

...

2 Commits

Author SHA1 Message Date
Leonardo de Moura
f834ac9a3b feat: add support for offsets at unifyEq?
closes #4219
2024-05-19 17:42:34 -07:00
Leonardo de Moura
72671d52ee fix: missing withIncRecDepth at unifyEqs? 2024-05-19 15:36:07 -07:00
4 changed files with 45 additions and 2 deletions

View File

@@ -714,4 +714,10 @@ theorem Expr.eq_of_toNormPoly_eq (ctx : Context) (e e' : Expr) (h : e.toNormPoly
simp [Expr.toNormPoly, Poly.norm] at h
assumption
end Nat.Linear
end Linear
def elimOffset {α : Sort u} (a b k : Nat) (h₁ : a + k = b + k) (h₂ : a = b α) : α := by
simp_arith at h₁
exact h₂ h₁
end Nat

View File

@@ -200,7 +200,7 @@ private def toCasesSubgoals (s : Array InductionSubgoal) (ctorNames : Array Name
{ ctorName := ctorName,
toInductionSubgoal := s }
partial def unifyEqs? (numEqs : Nat) (mvarId : MVarId) (subst : FVarSubst) (caseName? : Option Name := none): MetaM (Option (MVarId × FVarSubst)) := do
partial def unifyEqs? (numEqs : Nat) (mvarId : MVarId) (subst : FVarSubst) (caseName? : Option Name := none): MetaM (Option (MVarId × FVarSubst)) := withIncRecDepth do
if numEqs == 0 then
return some (mvarId, subst)
else

View File

@@ -21,6 +21,11 @@ structure UnifyEqResult where
subst : FVarSubst
numNewEqs : Nat := 0
private def toOffset? (e : Expr) : MetaM (Option (Expr × Nat)) := do
match ( evalNat e) with
| some k => return some (mkNatLit 0, k)
| none => isOffset? e
/--
Helper method for methods such as `Cases.unifyEqs?`.
Given the given goal `mvarId` containing the local hypothesis `eqFVarId`, it performs the following operations:
@@ -69,7 +74,30 @@ def unifyEq? (mvarId : MVarId) (eqFVarId : FVarId) (subst : FVarSubst := {})
return none -- this alternative has been solved
else
throwError "dependent elimination failed, failed to solve equation{indentExpr eqDecl.type}"
/- Special support for offset equalities -/
let injectionOffset? (a b : Expr) := do
unless ( getEnv).contains ``Nat.elimOffset do return none
let some (xa, ka) toOffset? a | return none
let some (xb, kb) toOffset? b | return none
if ka == 0 || kb == 0 then return none -- use default noConfusion
let (x, y, k) if ka < kb then
pure (xa, ( mkAdd xb (mkNatLit (kb - ka))), ka)
else if ka = kb then
pure (xa, xb, ka)
else
pure (( mkAdd xa (mkNatLit (ka - kb))), xb, kb)
let target mvarId.getType
let u getLevel target
let newTarget mkArrow ( mkEq x y) target
let tag mvarId.getTag
let newMVar mkFreshExprSyntheticOpaqueMVar newTarget tag
let val := mkAppN (mkConst ``Nat.elimOffset [u]) #[target, x, y, mkNatLit k, eqDecl.toExpr, newMVar]
mvarId.assign val
let mvarId newMVar.mvarId!.tryClear eqDecl.fvarId
return some mvarId
let rec injection (a b : Expr) := do
if let some mvarId injectionOffset? a b then
return some { mvarId, numNewEqs := 1, subst }
if ( isConstructorApp a <&&> isConstructorApp b) then
/- ctor_i ... = ctor_j ... -/
match ( injectionCore mvarId eqFVarId) with

9
tests/lean/run/4219.lean Normal file
View File

@@ -0,0 +1,9 @@
example (h : 2000 = 2001) : False := by
cases h
example (h : 20000 = 20001) : False := by
cases h
example (h : x + 20000 = 20001) : x = 1 := by
cases h
rfl