fix: let Meta.zetaReduce zeta reduce have expressions (#12695)

This PR fixes a bug in `Meta.zetaReduce` where `have` expressions were
not being zeta reduced. It also adds a feature where applications of
local functions are beta reduced, and another where zeta-delta reduction
can be disabled. These are all controllable by flags:
- `zetaDelta` (default: true) enables unfolding local definitions
- `zetaHave` (default: true) enables zeta reducing `have` expressions
- `beta` (default: true) enables beta reducing applications of local
definitions

Closes #10850
This commit is contained in:
Kyle Miller 2026-02-26 16:37:52 -08:00 committed by GitHub
parent 738688efee
commit 005f6ae7cd
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 119 additions and 10 deletions

View file

@ -185,17 +185,31 @@ def transform {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m]
return e
/--
Replaces all free variables in `e` that have let-values with their values.
The substitution is applied recursively to the values themselves.
Zeta-reduces `let`/`have` expressions in `e`, and also zeta-delta reduces let-bound variables.
Removes unused `let`/`have` expressions.
Options:
- If `zetaDelta` is true (default: true), then zeta-delta reduces (unfolds) let-bound variables.
- If `zetaHave` is false (default: true), then does not zeta reduce `have` expressions.
- If `beta` is true (default: true), then beta reduce applications of substituted values
-/
-- TODO: add options to distinguish zeta and zetaDelta reduction
def zetaReduce (e : Expr) : MetaM Expr := do
let pre (e : Expr) : MetaM TransformStep := do
let .fvar fvarId := e | return .continue
let some localDecl := (← getLCtx).find? fvarId | return .done e
let some value := localDecl.value? | return .done e
return .visit (← instantiateMVars value)
transform e (pre := pre) (usedLetOnly := true)
def zetaReduce (e : Expr) (zetaDelta := true) (zetaHave := true) (beta := true) : MetaM Expr := do
let n := (← getLCtx).numIndices
let unfold? (fvarId : FVarId) : MetaM (Option Expr) := do
let some decl ← fvarId.findDecl? | return none
if !zetaDelta && decl.index < n then return none
-- Values for nondep ldecls created by `transform` are valid.
return decl.value? (allowNondep := zetaHave && decl.index ≥ n)
if beta then
transform e (usedLetOnly := true) (pre := fun e => do
let .fvar fvarId := e.getAppFn | return .continue
let some value ← unfold? fvarId | return .continue
return .visit <| (← instantiateMVars value).beta e.getAppArgs)
else
transform e (usedLetOnly := true) (pre := fun e => do
let .fvar fvarId := e | return .continue
let some value ← unfold? fvarId | return .done e
return .visit (← instantiateMVars value))
/--
Zeta-reduces only the specified free variables, applying beta reduction after substitution.

95
tests/lean/run/10850.lean Normal file
View file

@ -0,0 +1,95 @@
module
public meta import Lean
/-!
# Testing `Lean.Meta.zetaReduce`
It needs to be able to reduce both `let` and `have` expressions.
Previously it was relying on the fact that `let` creates local definitions,
then zeta-delta reducing.
-/
open Lean Elab Term Meta Tactic
elab "zetaReduce " zd?:"zetaDelta"? zh?:"zetaHave"? beta?:"beta"? ":" t:term : tactic => withMainContext do
let e ← elabTermAndSynthesize t none
let e' ← zetaReduce e (zetaDelta := zd?.isSome) (zetaHave := zh?.isSome) (beta := beta?.isSome)
logInfo m!"Before reduction:{indentExpr e}\nAfter reduction:{indentExpr e'}"
/--
info: Before reduction:
(have m := 0 + 1;
m - 1) =
0
After reduction:
(have m := 0 + 1;
m - 1) =
0
---
info: Before reduction:
(have m := 0 + 1;
m - 1) =
0
After reduction:
0 + 1 - 1 = 0
---
info: Before reduction:
v
After reduction:
v
---
info: Before reduction:
v
After reduction:
2
---
info: Before reduction:
f v
After reduction:
f v
---
info: Before reduction:
f v
After reduction:
(fun n =>
have m := n;
m + 1)
2
---
info: Before reduction:
f v
After reduction:
have m := 2;
m + 1
---
info: Before reduction:
f v
After reduction:
(fun n => n + 1) 2
---
info: Before reduction:
f v
After reduction:
2 + 1
---
error: unsolved goals
v : Nat := 2
f : Nat → Nat :=
fun n =>
have m := n;
let m' := m;
m' + 1
⊢ True
-/
#guard_msgs in
example : True := by
let v := 2
let f n := have m := n; let m' := m; m' + 1
zetaReduce : (have m := 0 + 1; m - 1) = 0
zetaReduce zetaHave : (have m := 0 + 1; m - 1) = 0
zetaReduce : v
zetaReduce zetaDelta : v
zetaReduce : f v
zetaReduce zetaDelta : f v
zetaReduce zetaDelta beta : f v
zetaReduce zetaDelta zetaHave : f v
zetaReduce zetaDelta zetaHave beta : f v