lean4-htt/src/Lean/Meta/Tactic/Grind/Beta.lean
Leonardo de Moura 849a252b20
fix: case split on data in grind (#6781)
This PR fixes the support for case splitting on data in the `grind`
tactic. The following example works now:
```lean
inductive C where
  | a | b | c

def f : C → Nat
  | .a => 2
  | .b => 3
  | .c => 4

example : f x > 1 := by
  grind [
      f, -- instructs `grind` to use `f`-equation theorems, 
      C -- instructs `grind` to case-split on free variables of type `C`
  ]
```
2025-01-26 02:14:08 +00:00

77 lines
2.5 KiB
Text

/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
/-- Returns all lambda expressions in the equivalence class with root `root`. -/
def getEqcLambdas (root : ENode) : GoalM (Array Expr) := do
unless root.hasLambdas do return #[]
foldEqc root.self (init := #[]) fun n lams =>
if n.self.isLambda then return lams.push n.self else return lams
/--
Returns the root of the functions in the equivalence class containing `e`.
That is, if `f a` is in `root`s equivalence class, results contains the root of `f`.
-/
def getFnRoots (e : Expr) : GoalM (Array Expr) := do
foldEqc e (init := #[]) fun n fns => do
let fn := n.self.getAppFn
let fnRoot := (← getRoot? fn).getD fn
if Option.isNone <| fns.find? (isSameExpr · fnRoot) then
return fns.push fnRoot
else
return fns
/--
For each `lam` in `lams` s.t. `lam` and `f` are in the same equivalence class,
propagate `f args = lam args`.
-/
def propagateBetaEqs (lams : Array Expr) (f : Expr) (args : Array Expr) : GoalM Unit := do
if args.isEmpty then return ()
for lam in lams do
let rhs := lam.beta args
unless rhs.isLambda do
let mut gen := Nat.max (← getGeneration lam) (← getGeneration f)
let lhs := mkAppN f args
if (← hasSameType f lam) then
let mut h ← mkEqProof f lam
for arg in args do
gen := Nat.max gen (← getGeneration arg)
h ← mkCongrFun h arg
let eq ← mkEq lhs rhs
trace_goal[grind.beta] "{eq}, using {lam}"
addNewFact h eq (gen+1)
private def isPropagateBetaTarget (e : Expr) : GoalM Bool := do
let .app f _ := e | return false
go f
where
go (f : Expr) : GoalM Bool := do
if let some root ← getRootENode? f then
return root.hasLambdas
let .app f _ := f | return false
go f
/--
Applies beta-reduction for lambdas in `f`s equivalence class.
We use this function while internalizing new applications.
-/
def propagateBetaForNewApp (e : Expr) : GoalM Unit := do
unless (← isPropagateBetaTarget e) do return ()
let mut e := e
let mut args := #[]
repeat
unless args.isEmpty do
if let some root ← getRootENode? e then
if root.hasLambdas then
propagateBetaEqs (← getEqcLambdas root) e args.reverse
let .app f arg := e | return ()
e := f
args := args.push arg
end Lean.Meta.Grind