test: test case for #4751 (#4819)

and tracing for `IndPredBelow.backwardsChaining`.
This commit is contained in:
Joachim Breitner 2024-07-24 10:14:25 +02:00 committed by GitHub
parent 6d971827e2
commit 3701bee777
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 83 additions and 15 deletions

View file

@ -230,22 +230,28 @@ def mkBelowDecl (ctx : Context) : MetaM Declaration := do
ctx.typeInfos[0]!.isUnsafe
partial def backwardsChaining (m : MVarId) (depth : Nat) : MetaM Bool := do
if depth = 0 then return false
else
m.withContext do
let lctx ← getLCtx
m.withContext do
let mTy ← m.getType
lctx.anyM fun localDecl =>
if localDecl.isAuxDecl then
return false
else
commitWhen do
let (mvars, _, t) ← forallMetaTelescope localDecl.type
if ←isDefEq mTy t then
m.assign (mkAppN localDecl.toExpr mvars)
mvars.allM fun v =>
v.mvarId!.isAssigned <||> backwardsChaining v.mvarId! (depth - 1)
else return false
if depth = 0 then
trace[Meta.IndPredBelow.search] "searching for {mTy}: ran out of max depth"
return false
else
let lctx ← getLCtx
let r ← lctx.anyM fun localDecl =>
if localDecl.isAuxDecl then
return false
else
commitWhen do
let (mvars, _, t) ← forallMetaTelescope localDecl.type
if (← isDefEq mTy t) then
trace[Meta.IndPredBelow.search] "searching for {mTy}: trying {mkFVar localDecl.fvarId} : {localDecl.type}"
m.assign (mkAppN localDecl.toExpr mvars)
mvars.allM fun v =>
v.mvarId!.isAssigned <||> backwardsChaining v.mvarId! (depth - 1)
else return false
unless r do
trace[Meta.IndPredBelow.search] "searching for {mTy} failed"
return r
partial def proveBrecOn (ctx : Context) (indVal : InductiveVal) (type : Expr) : MetaM Expr := do
let main ← mkFreshExprSyntheticOpaqueMVar type
@ -596,5 +602,6 @@ def mkBelow (declName : Name) : MetaM Unit := do
builtin_initialize
registerTraceClass `Meta.IndPredBelow
registerTraceClass `Meta.IndPredBelow.match
registerTraceClass `Meta.IndPredBelow.search
end Lean.Meta.IndPredBelow

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

@ -0,0 +1,61 @@
inductive F: Prop where
| base
| step (fn: Nat → F)
-- set_option trace.Meta.IndPredBelow.search true
set_option pp.proofs true
/--
error: failed to infer structural recursion:
Cannot use parameter #1:
could not solve using backwards chaining x✝¹ : F
x✝ : x✝¹.below
f : Nat → F
a✝¹ : ∀ (a : Nat), (f a).below
a✝ : Nat → True
⊢ True
-/
#guard_msgs in
def F.asdf1 : (f : F) → True
| base => trivial
| step f => F.asdf1 (f 0)
termination_by structural f => f
def TTrue (_f : F) := True
/--
error: failed to infer structural recursion:
Cannot use parameter #1:
could not solve using backwards chaining x✝¹ : F
x✝ : x✝¹.below
f : Nat → F
a✝¹ : ∀ (a : Nat), (f a).below
a✝ : ∀ (a : Nat), TTrue (f a)
⊢ TTrue (f 0)
-/
#guard_msgs in
def F.asdf2 : (f : F) → TTrue f
| base => trivial
| step f => F.asdf2 (f 0)
termination_by structural f => f
inductive ITrue (f : F) : Prop where | trivial
/--
error: failed to infer structural recursion:
Cannot use parameter #1:
could not solve using backwards chaining x✝¹ : F
x✝ : x✝¹.below
f : Nat → F
a✝¹ : ∀ (a : Nat), (f a).below
a✝ : ∀ (a : Nat), ITrue (f a)
⊢ ITrue (f 0)
-/
#guard_msgs in
def F.asdf3 : (f : F) → ITrue f
| base => .trivial
| step f => F.asdf3 (f 0)
termination_by structural f => f